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tntroduct ion 


This Is a report on the data management programs used by the 
Stanford Remote Sensing Laboratory to access^ modify^ and reduce 
the data obtained from both the NASA IR airborne spectrometer/ and 
Stanford's SG-4 field spectrometer. Many details covered In 
previous reports are not repeated here. References are provided 
below. 

These programs are written In Fortran IV and S/360 Assembler 
Language/ and are currently running on a S/360 model 67 (operating 
under OS/MFT) at the Stanford Computation Center Campus Facility. 
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Program Descriptions 


I I . 


1, Program Cal 

Cal computes instrument calibration functions using NASA 
spectra. The required function is computed for each member of a 
group of spectra# and the mean and standard deviation over the 
group are printed and plotted. Currently the functions computed by 
Cal are not used for any further processing within the system. 

If the option INSTRANS is specified# the instrument response 
correction function is computed. This function may be used to 
correct for the non linear response of the spectrometer. It is 
computed by ratioing a theoretical blackbody spectrum to an 
observed blackbody spectrum. Since the spectrometer measures the 
radiation difference between the outside world and an internal 
reference# the theoretical blackbody mentioned above is the 
difference between two absolute radiance curves# one calculated 
using the target temperature# and the other calculated using the 
internal reference temperature. ^ 

P'-" 

If the option AIRPATH is specified# the airpath absorbion 
function is computed. Airborne blackbody spectra (from lakes# 
oceans etc.) are corrected for the instrument response and for the 
reflectance of water. The ratio of these corrected spectra to a 
theoretical blackbody spectrum is the airpath absorbsion function. 
This function descibes the effect of the air mass on the radiance 
levels seen by the spectrometer. 
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If the option EMIT! Is specified^ the ground rock emlttance 
spectrum is computed. Each ground rock spectrum is corrected for 
Instrument response and subtracted from a theoretical blackbody 
spectrum calculated at the internal spectrometer reference 
temperature. This gives an estimate of the absolute radiance of 
the target. The ratio of this to an absolute blackbody radiance 
curve gives the emlttance spectrum for the rock. 

Cal uses Splot for line printer plotting, I rrad for 

theoretical radiance calculations, Tcalc to estimate target 
temperature if unknown, and Sigma to compute standard deviations. 

2. Program Prep 

Prep is used to access and save small groups of spectra within 
the NASA data base. The spectra are time coded in increasing 
order. The program reads sequentially though the data base until 
the group Is found. Any spectra within the group whose temperature 
variance is above a given tolerance is rejected. The spectra 
alternate between up ramp (6.8-13.4 microns) and down ramp 
(13.4-6.8 microns) recording, but the output file contains only 
spectra of a given ramp code. The group average spectrum and 
standard deviation is printed and plotted for each group 
processed . 

Prep uses Splot for plotting. Table for data listing, Xlate to 
convert time, Rdnasa to read the data base. Unpack to unpack 
identification bytes, and Dater to provide the date and time for 
the printed output. 
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3 . Program Proc 


Proc Is used to process spectral groups produced by Prep. 
Since the data saved by Prep is contained in individual datasets, 
Proc finds groups by dataset name alone. The standard processing 
steps are as follows: the raw spectra are ratioed to a blackbody 
spectrum; the tails of the spectra are clipped since they contain 
little useful information; the ratioed spectra are smoothed to 
minimize the effects of random noise; and finally they are each 
normalized so the mean "radiance" of each spectrum is zero, with a 
standard deviation of one, allowing valid comparison of spectra 
with different mean intensities. 

The processed spectra are output onto a single file in card 
image format so that they may be read by classification programs 
such as BMD07M. The group average spectrum for each group is saved 
on a separate file so that the individuals may be further processed 
by program Discard. 

Proc uses Splot for plotting. Table for data listing, Dater 
for date and time. Norm for normalizing spectra, and Sm for 
smoothing spectra. 
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4. Program Discard 

Discard is used to delete from spectral groups spectra which 
vary greatly from the group mean. The program reads the output 
produced by Proc and computes for each member of a group the 
distance in Euclidean space from the group mean. If this distance 
is greater than a given tolerance, the spectrum is deleted from the 
group. There is no firm reason to think the information about a 
group is any better after this processing, but it has been found 
that spectra rejected by this method correspond well with the 
spectra which the classification programs cannot identify 
correct 1 y . 

Discard uses no subroutines. 

5. Program T rkload 

Trkload is used to copy ground based ("truck”) spectra tapes 
to disk. The organization of the disk file is different from the 
NASA data base in that individual spectra may be accessed directly. 
An index with pointers to the raw spectra is created which may be 
searched by later programs in order to find spectral groups. A 
program which does this searching and saves the groups in a format 
compatible with Proc has not been written yet, since the ground 
system is not fully operational. 

Trkload uses Rdtrk to read and convert the raw data tapes, and 
Daload to create the direct access file. Daload is used to bypass 
the formatting of direct access files which the FORTRAN direct 
access routines must do. 


s 



Program Fxanol es 


III. 


1 . Profi:ran Ca 1 


//CAL JOB (J032, 332^^10), MARSHALL 
//JOBLIB DO DSf!=jn32.PR0nLIB,niSP=SHP 
//VHYNOT EXEC PGM=CAL 

DSr! = jn^2.PRE4n,DISP=S!^P 
nSM=J032.SMALL,DISP=SHR 
SYS01JT=A 


//FT20F001 
//FT30Fn01 
//FT06F001 
//FT05F001 
108-1 

INSTRAMS 60. 
AIRPATI! 60. 


DO 

DD 

no 

on 


40. 

0.0 


20 

30 


MX108-1 

MX108-1 


PREFLIGMT BB 
SHALLOVf LAKE 


/* 


In this example, the dataset J032.PRE40 is used 
the instrument response correction Function, and 
J032. SHALL is used to calculate the airpath absorbsion 


to calculate 
the dataset 
function. 


2. Pro.cran Prep 


//PREP JOB (J032, 332, ,10), MARSHALL 
//JOBLIB on nSM=J032.PR0GLIB,DISP=SHR 
//HHYNOT EXEC PGM=PREP 

//riASA DD nsn=J032.FLIGHTl,niSP=SHR,nCR=OPTCn = C 
//FT20F001 DD DSr!=J032 . ROCKA, V0L = SER=IJSEP07, UN IT = 2314, 
// DISP=(,CATLG),SPACE=(TRK,5,RLSE),DCB=(RECFM=VBS, 

// BLKSIZE = 7294, LP.ECL = 400) 

//FT30F001 DD nsn=J03 2 . ROCKB, VOL=SER=USER0 7 , HM I T=2 314, 
// niSP=(,CATLG),SPACE=(TRK,5,RLSE),DCB=*.FT20F0ni 
//FT06F001 DD SYSnUT=A 
//FT05F001 DD * 

&PARMS TEMP=150., AEMn 
00 20 15 15 12345 15 15 23456 MXlOP.-l ROCKA 
00 30 15 16 12345 15 15 23456 MXlOS-l ROCKB 
/* 


In this example, J032.FLIGHT1 contains raw time-coded spectra 
from which the datasets J032. ROCKA and J032. ROCKB are created. The 
data cards contain the ramp code, lof^ical unit number for output, 
start and stop times, and some identication for each group of 
spectra. 
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3. 


Pronran Proc 


//PROC JOB (jn32,332,,in),MARS!'AI..L 
//JOP.LIR DO DSN = J032 . PRnnUB^DISP=SHR 
//WHYNOT FXRC PGM=PRnC 

//FT99F001 nn nSr!=jn32.SHALLAVG^niSP = SHR 
//FT20F001 DD DSM=jn32 . ROCKA, P I S P=B!'R 
//FT30Fn01 nn nBf!=J032.ROCKB^niSP=GHR 
//FT07F001 nn DSM=jn32.ROCKLIPI/niSP=MOn 
//FTOSFBOl nn DGr,'=J032.RnCKLIBA^niSP=MOn 
//FT06F001 no SYGOI.!T=A 
//FT05F001 nn * 

^iPARflS SMOOTH=T, CARn = 5, AENO 
THESE SPECTRA HAVE BEEN RATIOPn, SMOOTHER, AMP NORMAL I ZEP. 
00 20 15 15 12345 15 15 23456 MXlOS-1 ROCKA 
00 30 15 16 12345 15 16 23456 MXlOS-1 ROCKP 
/* 


In this exapple, the two datasets created in the previous 
exappie are processed and saved in J03 2 . ROCKL ! B I (for individual 
spectra) and in J03 2 . ROCKL I RA (for the avera.f^e of each group). 
Each spectrup is ratioed to an averaged blackbody spectrum 
contained in J032. SIIALLAVG, spoothed, and normalized. Mote that 
the control cards are the same as those used above. 


4. Profl:ram D i sea rd 


//RSL JOB (J032, 332, ,10), MARSHALL 
//JOBLIR nn nSN=J032. PROGLI R,niSP=SHR 
//V/HYMOT EXEC PGf^ = niSCARn 
//FTioFOOl nn nsr'=ja32.Rnc!a!BD,nisp=Mnn 
//FT03F001 nn nSM=J032.ROCKLIBI ,niSP=SHR 
//FT04F001 nn nSH=jn32.ROCKLIRA,niSP=SHR 
//FT06F001 on SYSni.!T=A 
//FT05F001 nn * 

APARMS LIMIT=30, AEMP 
&PARMS LIMIT=30, A END 


APARMS L!MIT=30, AENP 


In this example, data read from J032 . ROCKL ! B I are copied to 
JQ32 . ROCKL I BD rejecting any spectrup whose distance from the group 
mean is greater than a given tolerance. The group means are 
contained in J03 2 . ROCKL I BA, and the tolerance for each group is 
specified using the APARMS namelist. 
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5 , Pro.a:rnm T rkl oad 


//RSL JOB (J032, 332, ,10), MARSHALL 
//JOBLIB on DSH=J032.PROnLIR,DI$P=SHR 
//VJHYMOT EXEC PGM^TRKLOAP 

//RIRFCT HD DSM=jn32.TRnCKS,VOL=SER=USERn7,HNIT=2314, 

// SPACE=(CYL,in,RLSE),DISP=(,CATLn), 

// DCB=(DSORG=nA,KEYLEr!=n,RLKS|ZE=204) 

//SPECTAPE DD Ur! IT = 0C0, VOL = SER=TRUCK, LABEL = (, BLP), HI SP=SHR 
//FTlOFOOl nn nSM=jn32.T|MDEX,VOL = SER = llSFRn7,l!MIT = 2314, 

// 5PACE=(TRK,10,RLSE),D!SP=(,CATLG), 

// DCB=(RECFM=FB, LRECL=40,BLKSIZE=3520) 

//FT04F001 nn SYSOUT=A,nCB=(RECFM=FA,BLKSIZE=133) 
//FT06F001 DD SYSOUT=A, PCB=* . FTO 4F0 01 
//FT05F001 DD * 
fjPARf'S LIST=T, TERR=T, AEHD 


In this example, a truck tape calleH TRUCK, Is copied to disk. 
The spectra are saved in J032.TROCKS, and the identification 
information is saved in J032.T1MDEX. The namelist input specifies 
that the individual spectra are to he listed, and that rereads 
should be supressed in case of an error while reading the tape. 
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IV, Program Listings 


1. 1 Program Cal 


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

PROGRAM CAL — DECEMBER 1970 VERSION 


COMPUTES INSTRUMENT CALIBRATION FOR IR SPECTROMETER 
STANFORD REMOTE SENSING LABORATORY 

PROGRAM OPTIONS 

INSTRANS — COMPUTE INSTRUMENT RESPONSE CORRECTION FUNCTION. 

AIRPATH — COMPUTE AIRPATH ABSORBS I ON SPECTRUM FOR AIRBORNE 
BLACKBODY SPECTRA. 


EM ITT 


COMPUTE TARGET RADIANCE AND EMITTANCE SPECTRUM 
FOR KNOWN ROCK TYPES. 


SAVETRAN — READ/WRITE INSTRUMENT RESPONSE FUNCTION. 


INTEGER DISK^ CARD/5/, PRINT/6/, NMAX/30/ 

INTEGER INTRN/' I NST ' / , EM I TT/ ' EM I T ' / , A I RPT/ ' A I RP ' / , SAVET/ ' SAVE ' / 
INTEGER GET/'GET'/, PUT /'PUT'/, FLT, NAME(8), CNT(88) 

REAL RAW (38), DSK (92), IRAD(88), PLNK(88), ASP (88), 

* AINS(88), SINS(88), AAIR(88), SAIR(88), ARAD(88), 

* AEM (88), SEM (88), SSP (88), SRAD(88) 

REAL ZERO(88) /88*0.0/, FACT/0.0/ 


DEFINE REFLECTANCE CORRECTION FUNCTION 
REAL REFLT(88) 


* 

/ 

,9797, 

.9800, 

.9805, 

.9808, 

.9812, 

.9818, 

.9819 

* 


.9820, 

.9821, 

.9821, 

.9822, 

.9822, 

.9823, 

.9823 

☆ 


.9824, 

.9826, 

.9828, 

.9830, 

.9831, 

.9833, 

.9834 

* 


.9836, 

.9837, 

.98^3, 

.9841, 

.9843, 

.9845, 

.9847 

* 


.9848, 

.9850, 

.9853, 

.9855, 

.9858, 

.9861, 

.9863 

* 


.9865, 

.9869, 

.9373, 

.9877, 

.9881, 

.9885, 

.9888 

* 


,9891, 

.9895, 

.9899, 

.9903, 

.9907, 

.9910, 

.9913 

* 


,9917, 

.9920, 

.9923, 

.9926, 

.9929, 

.9930, 

.9932 

* 


.9933, 

.9932, 

.9931, 

.9930, 

.9926, 

.9922, 

.9918 

* 


.9912, 

.9906, 

.9900, 

.9897, 

.9893, 

.9890, 

.9887 

* 


.9984, 

.9980, 

.9974, 

.9968, 

.9962, 

.9857, 

.9851 

* 


.9844, 

.9835, 

.9824, 

.9810, 

.9794, 

.9778, 

.9762 

* 

* 

/ 

.9748, 

.9732, 

.9715, 

.9702 
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C IGNORE 4 WORD HEADER ON DATA READS. 

EQUIVALENCE (RAW(l), DSK(5)) 

C 

c 

C READ MISSION AND FLIGHT IDENTIFICATION. 

READ (CARD, 54) MISS, FLT 

C ■ 

C INITIALIZE SEQUENCE NUMBER ARRAY 

DO 2 I = 91,178 
2 CNT(l-90) » I 

C 

C READ PROGRAM OPTIONS 

10 READ (CARD,51,END»99) lOPT, REFT, BBT, DISK, NAME 
C 

IF (I OPT .EQ. SAVET) GOTO 50 
C 

C COMPUTE TARGET TEMPERATURE IF UNSPECIFIED. 

C 

IF (BBT .NE. 0.0) GOTO 11 
IF (FACT ,NE. 0.0) GOTO 12 
C 

C ERROR IN AUTOMATIC TEMPERATURE CALCULATION 

WRITE (PRINT, 97) 

STOP 

C 

12 BBT = TCALC (REFT, FACT, DISK) 

c- 

C BRANCH TO SPECIFIED ROUTINE 

11 IF (lOPT .EQ. AIRPT) GOTO 30 
IF (lOPT .EQ. EMITT) GOTO 40 
IF (lOPT .EQ. INTRN) GOTO 20 

C 

C ERROR IN OPTION CODE, STOP. 

WRITE (PRINT,61) 

STOP 

C 

C READ/WRITE RESPONSE FUNCTION 

50 IF (NAME(l) .EQ. PUT) WRITE (DISK) AINS 
IF (NAME(l) .EQ. GET) READ (DISK) AINS 
GOTO 10 


to 



cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
c 

C INSTRUMENT RESPONSE CORRECTION FUNCTION 

C 
C 

C THE RESPONSE FUNCTION IS THE RATIO OF A CALCULATED 
C IRRADIANCE CURVE TO AN OBSERVED BLACK BODY SPECTRUM 

C AT A GIVEN TEMPERATURE, IRRADIANCE IS THE DIFFERENCE 

C BETEEN TWO BLACKBODY RADIATORS^ ONE AT THE INTERNAL 

C SPECTROMETER REFERENCE TEMPERATURE^ AND ONE AT THE EXTERNAL 
C TARGET TEMPERATURE. 

C 

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 

c 

20 CONTINUE 

C 

C COMPUTE THEORETICAL NET IRRADIANCE 

CALL IRRAD (IRAD^ REFT, BBT) 

C 

C READ IN GROUND BLACKBODY SPECTRA AND COMPUTE RESPONSE OF EACH 
C 

DO 26 I ° 1,88 
ASP(I) = 0.0 
SSP(I) = 0.0 
AINS( I ) = 0.0 
AINS( I } ° 0.0 
SI NS( I ) « 0.0 
26 CONTINUE 

C 

DO 22 I « 1,NMAX 
READ (DISK, END-23) DSK 
C 

DO 22 J = 1,88 

ASP(J) - ASP(J) + RAW(J) 

SSP(J) » SSP(J) + RAW(J) ** 2 
AINS(J) » AINS(vJ) + IRAD(J)/RAW(d) 

SINS(J) » SINS(J) ♦ (IRAD(J)/RAW(J)) ** 2 

22 CONTINUE 
C 

C FIND STANDARD DEVIATIONS 

C 

23 NSPEC = 1-1 
EN = NSPEC 

CALL SIGMA (ASP, SSP, EN, 88) 

CALL SIGMA (AINS, SINS, EN, 88) 


tf 
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FIND OVERALL AVERAGES 

A! RAD ^ AVER ( IRAD^ 88) 
AASP = AVER (ASP/ 88) 
ASSP « AVER (SSP/ 88) 
AAINS = AVER (AIMS/ 88) • 
AS I NS AVER (SINS/ 88) 


PRINT AND PLOT RESULTS 

WRITE (PRINT/68) MISS/ FLT/ REFT/ BBT/ NSPEC/ NAME 
WRITE (PRINT/67) (CNT(I)/ IRAD(I)/ ASP(I)/ 

* SSP(I)/ AINS(I)/ SINS(I)/ I - 1/88) 

WRITE (PRINT/66) AIRAD/ AASP/ ASSP/ AAINS/ ASINS 

WRITE (PRINT/68) MISS/ FLT/ REFT/ BBT/ NSPEC/ NAME 
CALL SPLOT (IRAD/ ZERO/ 0.0/ 0.0/ PRINT/ 88/ 91) 

WRITE (PRINT/62) 

WRITE (PRINT/68) MISS/ FLT/ REFT/ BBT/ NSPEC/ NAME 
CALL SPLOT (ASP/ SSP/ 0.0/ 0.0/ PRINT/ 88/ 91) 

WRITE (PRINT/63) 

WRITE (PRINT/68) MISS/ FLT/ REFT/ BBT/ NSPEC/ NAME 
CALL SPLOT (AINS/ SINS/ 0.0/ 0.0/ PRINT/ 88/ 91) 

WRITE (PRINT/64) 


COMPUTE TEMPERATURE CONVERSION TABLE BASED ON LINEAR 
INTERPOLATION THROUGH (0/REFT) AND (AASP/BBT) 

FACT » (BBT - REFT) / AASP 
RR = 0.0 

WRITE (PRINT/93) MISS/ FLT/ REFT/ BBT/ NSPEC/ NAME 

C 

DO 28 I = 1/1101/25 
TT = REFT + FACT * RR 
WRITE (PRINT/94) RR/ T" 

RR = RR + 25.0 
28 CONTINUE 
C 

GOTO 10 


/ 2 . 



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 


c c 

C AIRPATH ABSORBSION FUNCTION C 
C C 
C C 
C AIRPATH ABSORBSION IS THE RATIO OF THE THEORETICAL C 
C NET IRRADANCE OF A BLACKBODY AT A GIVEN TEMPERATURE TO C 
C AN AIRBORNE BLACKBODY (IE LAKES, OCEAN) AT THE SAME C 
C TEMPERATURE, MULTIPLIED BY THE INSTRUMENT RESPONSE C 
C CORRECTION FUNCTION. C 
C MOD — WATER REFLECTANCE CORRECTION ADDED. C 
C C 


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 

c 

30 CONTINUE 
C 

C COMPUTE IRRADIANCE 

CALL IRRAD (I RAD, REFT, BBT) 

C 

C READ IN AIRBORNE BLACKBODY SPECTRA AND FIND AIRPATH OF EACH 

C 

DO 31 I = 1,88 
ASP (I) = 0.0 
SSP (I) = 0.0 
AAIR( I ) = 0.0 
SAIR( I ) = 0.0 

31 CONTINUE 
C 

DO 33 I = 1,NMAX 
READ(DISK, END-38) DSK 
C 

DO 33 J » 1,88 
ASP(J) =ASP(J) + RAW(J) 

SSP(J) = SSP(J) + RAW(J) ** 2 
T = IRAD(J) * REFLT(J) / RAW(J) / AINS(J) 

AAIR(J) = AAIR(J) + T 
SAIR(O) = SAIR(J) + T*T 
33 CONTINUE 
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FIND STANDARD DEVIATIONS 

NSPEC =1-1 
EN = NSPEC 

CALL SIGMA (ASP^ SSP^ EN, 88) 
CALL SIGMA (AAIR, SAIR, EN, 88) 

FIND OVERALL AVERAGES 

AASP = AVER (ASP, 88) 

ASSP = AVER (SSP, 88) 

AAAIR = AVER (AAIR, 88) 

ASAIR = AVER (SAIR, 88) 


PRINT AND PLOT RESULTS 

VmiTE (PR I NT, 68) MISS, FLT, REFT, BBT, NSPEC, NAME 
VmiTE (PRINT, 65) (CNT(I), ASP(I), 

* SSP(I), AAIR(I), SAIR(I), I « 1,88) 

WRITE (PR I NT, 66) AASP, ASSP, AAAIR, ASAIR 
C 

WRITE (PRINT, 68) MISS, FLT, REFT, BBT, NSPEC, NAME 
CALL SPLOT (ASP, SSP, 0.0, 0.0, PRINT, 88, 91) 

WRITE (PRINT,86) 

C 

WRITE (PRINT, 68) MISS, FLT, REFT, BBT, NSPEC, NAME 
CALL SPLOT (AAIR, SAIR, 0.0, 0.0, PRINT, 88, 91) 

WRITE (PRINT,87) 

C 

GOTO 10 



ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
c 

C GROUND ROCK EMITTANCE SPECTRUM 

C 
C 

C EMITTANCE IS FOUND BY RATIOING THE TARGET RADIANCE TO 

C A CALCULATED BLACKBODY RADIATOR AT THE SAME TEMPERATURE. 

C THE TARGET RADIANCE IS FOUND BY SUBTRACTING FROM THE 

C INTERNAL REFERENCE SPECTRUM AN OBSERVED ROCK SPECTRUM 

C MULTIPLIED BY THE INSTRUMENT RESPONSE FUNCTION. 

C 

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

c 

40 CONTINUE 

C COMPUTE ABSOLUTE INTERNAL RADIANCE 

CALL ABSL (PLNK^ REFT) 

C 

C COMPUTE RADIANCE FOR BLACKBODY AT TARGET TEMPERATURE 
CALL ABSL (IRAD^ BBT) 

C 

C READ IN SPECTRA AND COMPUTE TARGET RADIANCE 

C 

DO 41 I « 1,88 
ASP (I) = 0.0 
SSP ( I ) = 0.0 
ARAD(I) « 0.0 
SRAD( I ) = 0.0 
AEM ( I ) = 0.0 
SEM ( I ) » 0.0 

41 CONTINUE 
C 

DO 42 I - 1,NMAX 
READ (DISK, END-45) DSK 
C 

DO 42 J = 1,88 

SSP(J) » SSP(J) + RAW(J) ** 2 
ASP(J) -ASP(J) + RAW(J) 

C 

C COMPUTE TARGET RADIANCE (T) 

T = PLNK(J) - RAW(J) * AINS(J) 

ARAD(J) - ARAD(J) + T 
SRAD(J) - SRAD(J) + T*T 


oooooooooo 
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C COMPUTE EMITTANCE (TT) 

TT » T/IRAD(J) 

AEM(J) = AEM(J) + TT 

SEM(J) = SEM(J) ♦ TT ** 2 

42 CONTINUE 

C 

45 NSPEC =1-1 

EN - NSPEC 

FIND STANDARD DEVIATIONS 

CALL SIGMA (ASP^ SSP, EN, 88) 

CALL SIGMA (ARAD, SRAD, EN, 88) 

CALL SIGMA (AEM, SEM, EN, 88) 

FIND OVERALL AVERAGES 

AASP = AVER (ASP, 88) 

ASSP = AVER (SSP, 88) 

AARAD = AVER (ARAD, 88) 

ASRAD = AVER (SRAD, 88) 

ASEM = AVER (SEM, 88) 

AAEM = AVER (AEM, 88) 

PRINT AND PLOT RESULTS 

WRITE (PRINT, 68) MISS, FLT, REFT, BBT, NSPEC, NAME 
WRITE (PRINT, 95) (CNT(I), ASP(I), SSP(I), 

* ARAD(I), SRAD(I), AEM(I), SEM(I), I » 1,88) 

WRITE (PRINT, 96) AASP, ASSP, AARAD, ASRAD, AAEM, ASEM 
C 

WRITE (PRINT, 68) MISS, FLT, REFT, BBT, NSPEC, NAME 
CALL SPLOT (ASP, SSP, 0.0, 0.0, PRINT, 88, 91) 

WRITE (PRINT, 81) 

C 

WRITE (PRINT, 68) MISS, FLT, REFT, BBT, NSPEC, NAME 
CALL SPLOT (ARAD, SRAD, 0.0, 0.0, PRINT, 88, 91) 

WRITE (PRINT, 82) 

C 

WRITE (PRINT, 68) MISS, FLT, REFT, BBT, NSPEC, NAME 
CALL SPLOT (AEM, SEM, 0.0, 0.0, PRINT, 88, 91) 

WRITE (PR I NT, 83) 

C 

GOTO 10 





C END OF FILE READ 

99 WRITE (PRINT^69) 

STOP 

C 

C 

51 FORMAT(A4,T10,2F10.5, I2,T40,8A4) 

54 FORMATC I3,1X^ ID 

55 F0RMAT(A4D2) 

61 FORMATC///’ RSL050I OPTION CODE INVALID') 

62 FORMATC//T54, 'THEORETICAL NET IRRADIAHCE') 

63 F0RMAT(//T50, 'AVERAGED GROUND BLACKBODY SPECTRUM') 

64 FORMAT(//T50, ' INSTRUMENT RESPONSE CORRECTION FUNCTION') 

65 FORMAT( T20,'AVER SPECTRUM' ,T40. 'STANDARD DEV' ,T60, 'AVER 

* 'AIRPATH'^TSO, 'STANDARD DEV'//( 110, 4E20. 3)) 

66 FORMAT(//T11,6E20.3) 

67 FORMAT(T23, 'DIFFRAD',T40, 'AVER SPECTRUM' ,T60, ' STANDARD DEV', 

* T8 0,' I NSTRANS',T100, 'STANDARD DEV // ( 1 10, 5E20 .3 ) ) 

68 FORMAT('1',T10, 'MISSION', 14,' FLIGHT ',11,' CALIBRATION.'// 

* TIO, ' INTERNAL REFERENCE TEMPERATURE IS',F4.0,' DEGREES ' 

* , 'CENTIGRADE. '/TIO, 'EXTERNAL TEMPERATURE IS',F4.0, 

* ' DEGREES CENTIGRADE. '/TIO, 'USED' , 13, ' SPECTRA — ',8A4/// 

* ) 

69 FORMAT( 'IRSLOOll NORMAL END OF RUN') 

81 FORMAT(//T54, 'AVERAGED ROCK SPECTRUM') 

82 FORMAT(//T60, 'TARGET RADIANCE') 

83 FORMAT(//T60, 'EMITTANCE SPECTRUM') 

86 FORMAT(//T47, 'AVERAGED AIRBORNE BLACKBODY . SPECTRUM ' ) 

87 FORMAT(//T51, 'AIRPATH ABSORBSION SPECTRUM') 

93 FORMAT( '1', TIO, 'MISSION', 14, ' FLIGHT ',11, 

* ' TEMPERATURE CONVERSION TABLE.'// 

* TIO, ' INTERNAL REFERENCE TEMPERATURE IS',F4.0,' DEGREES ' 

* , 'CENTIGRADE. '/TIO, 'EXTERNAL TEMPERATURE IS',F4.0, 

* ' DEGREES CENTIGRADE. '/TIO, 'USED', 13, ' SPECTRA -- ',8A4/// 

* T13, 'READING' ,T33, 'TEMPERATURE' ) 

94 FORMAT(F17.0,F23.1) 

95 FORMAT(T10, 'AVER S PECTRUM ', T30, ' STANDARD DEV , T50, ' TARGET RAD', 

* T70, 'STANDARD DEV' , T90, ' EM I TTANCE ', TllO, ' STANDARD DEV'// 

* ( I4,E16.3,5E20.3)) 

96 F0RMAT(//4X,E16.3,5E20o3) 

97 FORMATC0RSL052I CANNOT COMPUTE TARGET RADIANCE') 

END 


if 



1.2 Subroutine §p],.at 
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c C 

C SPLOT -- SPECTRUM PLOT PROGRAM C 

C C 

C MEAN — ARRAY CONTAINING AVERAGE SPECTRUM C 

C SD — ARRAY CONTAINING STANDARD DEVIATION OF SPECTRUM C 

C MIN — PLOT LEFT BOUND C 

C MAX — PLOT RIGHT BOUND C 

C LOG UNIT ON WHICH PLOT IS WRITTEN (LRECL > 130) C 

C NPT NUMBER OF POINTS IN ARRAYS (SIZE OF PLOT) C 

C COUNT — INITIAL SEQUENCE NUMBER C 

c c 

C N.B. IF MIN»MAX THE PROGRAM WILL FIND BOUNDS TO FIT THE DATA C 
C C 


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

c 

SUBROUTINE SPLOT (MEAN ,SD^ MIN^ MAX, LOG, NPT, COUNT) 

INTEGER COUNT 

REAL MIN, MAX, MEAN(NPT), SD(NPT) 

REAL GRAPH(lOl), YCORD(ll), XXXX/ ' XXXX ' // STAR/'****'// MARK, 
* PLUS/'****'/, MINUS/' '/, DOT/'....'/, BLANK/' '/ 

C 

XMIN = MIN 
XMAX = MAX 
NPTS = NPT 
ICNT = COUNT 

C 

IF (XMIN .LT. XMAX) GOTO 10 
C 

C FIND XMIN AND XMAX 

C 

XMIN s MEAN(l) - SD(1) 

XMAX = MEAN(l) + SD(1) 

DO 20 I - 2, NPTS 

XMIN - AMINl (XMIN,MEAN( I )-SD( I )) 

XMAX = AMAXl (XMAX,MEAN( I )+SD( I )) 

20 CONTINUE 

FUDGE = .02 * (XMAX - XMIN) 

XMAX = XMAX ♦ FUDGE 
XMIN = XMIN - FUDGE 
C 

10 DELTA = (XMAX - XMIN) / 100. 

WRITE (LOG, 54) XMIN, XMAX, DELTA 

c 

C COMPUTE AND PRINT Y COORDINATES 

C 

YCORD(l) XMIN 
DO 30 I » 2,11 

YCORDCI) = YCORD(l“l) + DELTA * 10. 

30 CONTINUE 



WRITE (LOG^Sl) YCORD 
WRITE (LOG^52) 

C 

DO 50 I = IW'IPTS 
C INITIALIZE GRAPH LINE. 

C 

MARK » BLANK 

IF (MOD(MO) .EQo 0) MARK » DOT 
DO 40 J » 1,101 
GRAPH(J) = MARK 

40 CONTINUE 

C 

DO 35 J = 1,101,10 
GRAPH(J) = DOT 

35 CONTINUE 

C 

C COMPUTE POSITIONS. 

C 

SM = MEAN(I) - XMIN 
ISM » SM/DELTA +0.5 
ISD = SD(I) / DELTA 
ISL » ISM - ISD 
ISH = ISM + ISD 
IF (ISM .LT. 2) GOTO 45 
LL = MINO (ISM-1, 101) 

DO 60 J = 1,LL 
GRAPH(J) » XXXX 
60 CONTINUE 

C 

45 IF (ISH .GE. 1 .AND. ISH .LE. 101) GRAPH(ISH) « PLUS 

IF (ISL .GE. 1 .AND. ISL .LE. 101) GRAPH(ISL) « MINUS 

IF (ISM .GE. 1 .AND. ISM .LE. 101) GRAPH(ISM) » STAR 

C 

WRITE (LOG, 53) MEAN(I), ICNT, GRAPH, ICNT 

C 

ICNT = ICNT + 1 

50 CONTINUE 
C 

WRITE (LOG, 52) 

WRITE (LOG, 51) YCORD 
RETURN 
C 

51 FORMAT (17X,ll(E9.2,iy)) 

52 FORMAT ( 19X, 10( '.*********'),'.' ) 

53 FORMAT (3X, ElO . 2, I 5 , IX, lOlAl, I 5 ) 

54 FORMAT (/25X,'XMIN I S ' , E9 . 2, 15X, ' XMAX I S' , E9. 2, 15X, ' DELTA IS', 

^ E9.2/) 

END 


/f 
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SUBROUTINE I RRAD (IRAD, REFT, BBT) 

REAL I RAD (88) 

REAL LAMl/6. 8/, LAM88/ 13. 4/, Cl/37410./, 02/ 14338./, PI /3. 141593/ 


C 

C DEFINE BLACK BODY RADIANCE FUNCTION 

RAD (T, W) = Cl / (PI * (EXP (C2 / (W * T)) - 1.0) * W ** 5) 

COMPUTE NET IRRADIANCE 

TEMPI = REFT ♦ 273. 

TEMP2 = BBT + 273. 

DLAM = (LAM88 - LAMl) / 87.0 
WV^ = LAMl 
DO 21 I ® 1 88 

IRAD(I) = RAD(TEMP1,WW) - RAD(TEMP2,WW) 

WW « WW ♦ DLAM 
CONTINUE 
RETURN 

COMPUTE ABSOLUTE RADIANCE 

ENTRY ABSL (I RAD, TEMP) 

TEMPI = TEMP ♦ 273. 

DLAM =■ (LAM88 - LAMl) / 87.0 
WW = LAMl 
DO 22 I = 1,88 
IRAD(I) ■= RAD(TEMP1,WW) 

WW =» WW + DLAM 
22 CONTINUE 
RETURN 
END 
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Subroutines Tcalc , Aver , sni g.J ama 


REAL FUNCTION TCALC (REFT^ FACT^ DISK) 

INTEGER DISK 

REAL RAW(88)^ DSK(92) 

EQUIVALENCE (RAW(l), DSK(5)) 

C 

ACC = 0.0 

DO 10 I « 1,30 

READ (DISK, END-20) DSK 

DO 10 J - 1,88 

ACC » ACC ♦ RAW(J) 

10 CONTINUE 

C 

20 EN « FLOAT(l-l) * 88 

TCALC » REFT ♦ FACT * (ACC/EN) 

REWIND DISK 

RETURN 

END 


REAL FUNCTION AVER (A, N) 
REAL A(N) 

S - 0.0 
DO 10 I » 1,N 
10 S = S + A( I ) 

AVER - S / N 

RETURN 

END 


SUBROUTINE SIGMA (MEAN, SD, EN, NPT) 

REAL MEAN(NPT), SD(NPT) 

DO 10 I - 1,NPT 

SD(I) - SQRT ((SD(I) - MEAN( I )**2/EN) / (EN-1.0)) 
MEAN( I ) = MEAN( I ) / EN 
10 CONTINUE 
RETURN 
END 


2^1 
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Prep 


cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
PROGRAM PREP — SPECTRUM PRE-PROCESSOR 
PROGRAM DESCRIPTION 

PREP READS RAW SPECTRAL DATA IN 1969 NASA FORMAT AND 
OUTPUTS SPECTRA WITHIN GIVEN TIME LIMITS IN STANDARD 
FORMAT COMPATIBLE WITH PROGRAM TASK. PRINTED OUTPUT 
CONSISTS OF THE IDENTIFICATION HEADER ASSOCIATED WITH 
EACH OUTPUT SPECTRUM, THE RECORDING TIME IN THE FORM 
HHsMMiSS.MSEC, THE MINIMUM, MAXIMUM, AND AVERAGE RADIOMETER 
READING, AND THE STANDARD DEVIATION FOR THE NINE 
RADIOMETER SAMPLES. THE AVERAGE RAW SPECTRUM, ALONG WITH 
THE STANDARD DEVIATION FOR EACH COUNTER POINT IS PRINTED 
AND PLOTTED FOR EACH GROUP OF SPECTRA PROCESSED. 

RECORD FORMATS 

THE FIRST TWELVE BYTES ARE IDENTICAL IN BOTH FORMATS, 

THESE REPRESENT THE IDENTIFICATION PART OF THE SPECTRUM 
(8 BYTES) AND THE TIME OF DAY IN ELAPSED MILLISECONDS. 

NEXT COME THE SPECTROMETER DATA POINTS (88) IN HALFWORD 
INTEGERS ON THE TAPE, AND FULLWORD FLOATING POINT ON THE 
OUTPUT FILES. LAST COMES THE CALIBRATION HALFWORDS. THE 
FIRST NINE OF THESE ARE RADIOMETER READINGS. 

TEMPERATURE VARIANCE 

SPECTRA WHOSE TEMPERATURE VARIANCE IS GREATER THAN A 
GIVEN LIMIT ARE NOW BYPASSED (2/9/71). A NAMELIST 
MUST PRECEDE THE CONTROL CARDS OF THE FORM: 

&PARMS TEMP=NNN., SEND, WHERE NNN IS IN MILLIVOLTS. 

DECK SETUP 

RR UU AA AA AAAAA ZZ ZZ ZZZZZ TTTTTTTTTTTTTTTTTTTTTTTTTTTTT 
R — RAMP CODE (00*UP, 01=DOWN) 

U OUTPUT UNIT NUMBER (A DD CARD MUST BE SUPPLIED) 

A — START TIME IN HH MM SSTTT FORMAT 
Z — STOP TIME IN SAME FORMAT 

T — THE REST OF THE CARD MAY CONTAIN A TITLE FOR THE 
PRINTED OUTPUT, 

ANY NUMBER OF INPUT CARDS MAY BE USED BUT THE TIMES 
MUST APPEAR IN INCREASING ORDER TO AVOID REREADING THE 
INPUT DATASET, 

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
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INTEGER CARD/5/, PRINT/6/, DISK, NMAX/88/, RMAX/9/ 

INTEGER AH, AM, AS, ZH, ZM, ZS, HR, MN, MS, TITLE(8) 

INTEGER BEGIN, END, LAST, TIME/0/, DUMMY/0/ 

INTEGER NAME(2)/' UP', 'DOWN'/, DATE(5) 

INTEGER*2 INBUF(150), HEADER(6), RAD(35), RAMP 
INTEGER*2 MISDAY, L INRUN, SI TUNS, ERRAMP, 

MIS, DAY, LIN, RUN, SIT, UNS, ERR 
REAL SPECT(88), ASP(88), SSP(88), RSP(88), ZERO( 88 )/ 88 *0 . 0/ 
EQUIVALENCE (INBUF(l), HEADER(l)), (INBUF(95), RAD(D) 


EQUIVALENCE 

(HEADER(l), 

MISDAY), 

* 

(HEADER(2), 

L INRUN), 

* 

(HEADER(3), 

SI TUNS), 

C! 

(HEADER(4), 

ERRAMP), 


(HEADER(5), 

TIME ) 


DEFINE NAMELIST 
DATA TEMP /150./ 
NAMELIST /PARMS/ TEMP 


DEFINE MILLISECOND CONVERSION FORMULA 
MSEC (IH, IM, IS) = 3600000*IH + 60000*IM + IS 

READ NAMELIST 
READ (CARD, PARMS) 

RRMAX * RMAX 
RNMAX = NMAX 
NREAD = 0 

GET DAY DATE & TIME 
CALL DATER (DATE) 

READ CONTROL CARD 
10 READ (CARD,51, END=99) RAMP, D I SK, AH, AM, AS, ZH, ZM, ZS, T I TLE 
I NAME = RAMP + 1 
ICNT = 1 

IF (RAMP oEQ. 0) ICNT = 91 

WRITE (PRINT, 61) NAME ( I NAME ) , AH, AM, AS, ZH, ZM, ZS , T I TLE, DATE 
C 

C CONVERT TO MILLISECONDS 

BEGIN = MSEC (AH, AM, AS) 

END = MSEC (ZH,ZM,ZS) 

C 

C CHECK FOR ERRORS 

IF (END .GE. BEGIN .ANT- END .GE. BEGIN) GOTO 19 
WRITE (PRINT, 67) TITLE 
GOTO 10 
C 

19 DO 20 I = 1,NMAX 
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ASP( I ) = 0.0 
SSP( I ) * 0.0 
20 COMTINUE 
MSPEC = 0 
NOEL = 0 
AARAD =0.0 
ASRAD = 0.0 
GHIGH = -1E70 
GLOW = 1E70 
WRITE (PRINT, 64) 
GOTO 15 


INPUT READ LOOP 

0 CALL RDNASA (INBUF, I EOT) 

IF ( I EOT .EQ. 1) GOTO 40 
NREAD = NREAD + 1 

CHECK FOR ERROR AND WRONG RAMP AT SAME TIME 
IF (ERRAMP .NE. RAMP) GOTO 30 

CHECK FOR WITHIN TIME LIMITS 
5 IF (TIME .LT. BEGIN) GOTO 30 
IF (TIME .GT. END) GOTO 50 

SPECTRUM FOUND WITHIN RANGE 
NSPEC = NSPEC + 1 

UNPACK HEADER 

CALL UNPACK (MISDAY, MIS, DAY) 

CALI. UliPACK (LINRUN, LIN, RUN) 

CALL UNPACK (SITUNS, SIT, UNS) 

CONVERT TIME 

HR = TIME/3600000 

MN = MOD(TIME/60000,60) 

MS = MOD(TIME, 60000) 

C 

C PROCESS RADIOMETER VALUES 

ARAD = 0.0 
RHI'iH = -1E70 
RLOW* = 1E70 
DO 45 I = 1,RMAX 
R = RAD( I ) 

RHIGH = AMAXl (RHIGH,R) 

RLOW = AM INI (RLOW,R) 

ARAD = ARAD + R 
45 CONTINUE 

SRAD = RHIGH ~ RLOW 

GHIGH = AMAXl (GH I GH, RH I GH) 
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GLOV^ = AM INI (GLOWER LOW) 

ARAD = ARAD/RRMAX 
AARAD = AARAD + ARAD 
AS RAD = AS RAD + SRAD 
C. WRITS SPECTRUM AMD RAD INFO 

WRITE (PR I NT, 63) MSPEC, MIS, DAY, LIN, RUN, SIT, RAMP, 

* HR, MM, MS, RLOW, RHIGH, ARAD, SRAD 

C 

C CHECK FOR UNACCEPTABLE TEMPERATURE VARIANCE 

IF (SRAD .LE. TEMP) GOTO 31 
NDEL = NDEL + 1 
WRITE (PR I NT, 71) 

GOTO 30 
C 

C SUM SPECTRA 

31 DO 60 I = 1,NMAX 

SPECT(I) = INBUF(I^6) 

ASP( I ) = ASP( I ) + SPECT( I ) 

SSP(I) = SSP(I) + SPECT(I) ** 2 
60 CONTINUE 

C 

C WRITE OUTPUT RECORD 

IF (DISK .NE. 0) WRITE (DISK) HEADER, DUMMY, SPECT, RAD 
GOTO 30 

END OF READ LOOP 
0 RNSP = N5PEC 

AARAD = AARAD / RNSP 

ASRAD = ASRAD / RNSP 

NSPEC = NSPEC - NDEL 

IF (NSPEC .LT. 2) WRITE (PRINT, 62) 

IF (NSPEC .LT. 2) GOTO 10 
WRITE (PR I NT, 85) 

WRITE (PR I NT, 79) GLOW, GHIGH, AARAD, ASRAD 

WRITE OUT AVERAGED SPECTRA, STANDARD DEV, AND REL ERROR 
WRITE (PRINT, 61) NAME ( I NAME ) , AH, AM, AS, ZH, ZM, ZS, T I TLE, DATE 
WRITE (PRINT, 65) NSPEC 
IF (RAMP .EQ. 0) WRITE (PR I NT, 81) 

IF (RAMP .EQ. 1) WRITE (PR I NT, 82) 

CALL TABLE (ASP, SSP, NMAX, NSPEC, ICNT, PRINT, 'RELATIVE') 
C 

C PLOT AVERAGED SPECTRUM 

WRITE (PRINT, 61) NAME ( I NAME ) , AH, AM, AS , ZH, ZM, ZS, T I TLE, DATE 

WRITE (PRINT, 65) NSPEC 

IF (RAMP .EQ. 0) WRITE (PR I NT, 81) 

IF (RAMP .EQ. 1) WRITE (PRINT, 82) 

CALL SPLOT (ASP, SSP, 0.0, 0.0, PRINT, 88, ICNT) 

WRITE (PRINT, 84) 





C PLOT STANDARD DEVIATION 

WRITE (PRINT, 61) NAME ( I NAME ) , AH, AM, AS, ZH, ZM, ZS, T I TLE, DATE 

WRITE (PRINT, 65) MSPEC 

IF (RAMP .EQ. 0) WRITE (PRINT, 81) 

IF (RAMP ,EQ. 1) VmiTE (PRINT, 82) 

CALL SPLOT (SSP, ZERO, 0.0, 100., PRINT, 88, ICNT) 

WRITE (PRINT, 83) 

GOTO 10 
C 

C END OF FILE EXITS 

40 WRITE (PR I NT, 68) 

WRITE (PR I NT, 69) MREAD 
STOP 

99 WRITE (PRINT, 69) NREAD 

WRITE (PRINT, 66) 

STOP 

C 

C 

51 FORMAT(4( I2,1X), I5,1X,2( I2,1X), I5,1X,8A4) 

61 FORMAT( 'l',A4, ’ RAMP SPECTRUM GROUP ( ' , 2 ( I 2, IX) , I 5, ' TO ', 

* 2( I2,1X), 15, ' ) CALLED -- ’,13A4) 

62 FORMAT(///' RSL020I INSUFFICIENT RECORDS — GROUP BYPASSED') 

63 FORMATdOX, I7,3X,6I7,5X,2I3, I6,3X,3F10.0,F10.1) 

64 FORMAT(//20X,'MISSION',4X,'DAY',3X,'LINE',4X, 'RUN',3X, 'SITE', 

* 3X, 'RAMP', 7X, 'TIME', 9X, 2X,'LOW RAD ' , 3X, ' H I GH RAD',3X, 

* 'AVER RAD', 3X, 'DEL RAD'/) 

65 FORMATC NUMBER OF SPECTRA IN GROUP: ',14) 

66 FORMATC RSLOOll NORMAL END OF RUN') 

67 FORMAT(///' RSL032I TIMES NOT SPECIFIED IN INCREASING ORDER'/ 

* ' RSL032I ',20A4) 

68 FORMAT( 'ORSL030I DATA EXHAUSTED -- END OF GROUP NOT FOUND') 

69 FORMATClRSLOOOl ',15,' RECORDS READ') 

71 FORMAT( ' + ',T130, '<=' ) 

79 FORMAT(/72X, 'GROUP: ' , 3F10 .0, FIO . 1 ) 

81 FORMATC COUNTERS RANGE FROM 6.8 TO 13.4 MICRONS') 

82 FORMATC COUNTERS RANGE FROM 13.4 TO 6.8 MICRONS') 

83 FORMAT(//T53, 'PLOT OF STANDARD DEVIATION') 

84 FORMAT(//T57, ' PLOT OF GROUP MEAN') 

85 FORMAT(//84X, ' LOW RAD ' , 3X, ' H I GH RAD ', 3X, ' AVER RAD', 3X, 'DEL RAD') 
END 
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c 

C SUBPROGRAM TABLE 

C 

C THE ROUTINE COMPUTES AND PRINTS THE MEAN^ STANDARD 
C DEVIAT 
C A GROU 
C 

C AVG 
C 

C SD 
C 

c rjpT 

C MSPCT 
C 

C I CNT 
C PR I NT 
C MODE 
C 
C 

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

c 

c 

SUBROUTINE TABLE (AVG, SD, NPT, NSPCT, INCT, PRINT, MODE) 

REAL AVG(NPT), SD(NPT), RE(IOO) 

INTEGER PRINT, MODE(2), REL /'RELA'/ 

C 

C COMPUTE STATISTICS 

EN = NSPCT 
SQRTN = SQRT (EN) 

DO 10 I = 1,NPT 

SD(I) = SORT ((SD(I) - AVG( I )**2/EN) / ( EN - 1.0)) 

AVG( I ) = AVG( I ) / EN 
RE( I ) = SD( I ) / SQRTN 

IF (MODE(l) .EQ. REL) RE( I ) = RE( I ) / AVG( I ) 

10 CONTINUE 

C 

C FIND OVERALL AVERAGES 

AAVG = AVER (AVG, MPT) 

ASD = AVER (SD, NPT) 

ARE = AVER (RE, NPT) 


^7 


ION, AMD RELATIVE ERROR OF EACH COUNTER POINT IN 
P OF SPECTRA. 

-- A VECTOR CONTAINING THE SUM OF THE SPECTRA 
THE SPECTRUM MEAN IS RETURNED IN AVG. 

-- A VECTOR CONTAINING THE SUM OF THE SPECTRA SOUARED 
THE SPECTRUM STANDARD DEV IS RETURNED IN SD. 

-- THE NUMBER OF COUNTER POINTS 
-- THE NUMBER OF SPECTRA IN THE GROUP 

THIS NUMBER MUST MUST BE GREATER THAN 1 

— THE INITIAL COUNTER POINT SEQUENCE NUMBER 
-- PRINTER UNIT NUMBER 

— 'RELATIVE' FOR RELATIVE ERROR 
'STANDARD' FOR STANDARD ERROR 


OOCDOOOOOOOOOOOOOOOO 



o o o 


c 


20 

c 

c 

61 

62 

63 


PRINT TABLE 
WRITE (PR I NT, 63) MODE 
1C = INCT 
DO 20 I = 1,NPT 

WRITE (PRINT, 61) 1C, AVG(I), SD(I), RE( I ) 

!C » !C ♦ 1 
CONTINUE 

WRITE (PRINT, 62) AAVG, ASD, ARE 
RETURN 

FORMAT ( I16,2F20.2,F20.5) 

FORMAT (/T13,'MEAN’ , 2F20 . 2, F20 . 5 ) 

FORMAT (/T13, 'COUNTER', T27, 'AVER SPECTRUM' ,T48, 'STANDARD DEV', 
* T66,2A4,' ERROR') 

END 


2.3 Subrout ine XI ate 


SUBROUTINE XLATE (TIME, HMS) 

INTEGER TIME, HMS(3) 

TRANSLATE FROM ELAPSED MSEC TO HH;MM:SS.MSEC FORMAT 

HMS(l) = TIME / 3600000 
HMS(2) = MOD (TIME/60000,60) 

HMS(3) = MOD (TIME, 60000) 

C 

RETURN 

END 





2 .4 Subrout I ne Rdnasa 



TITLE 

•RDNASA — NASA 

TAPE 

READ PROGRAM' 


MACRO 



PROVIDE STANDARD OS LINKAGE 

&CSECT 

LINKS 

&SAVE,&BASE=12 


GIVE CSECT NAME, SAVEAREA 


LCLC 

&NAME 


NAME, AND GLOBAL BASE REG 

&NAME 

SETC 

•&SAVE' 


SAVE IF SPECIFIED 


AIF 

(•&NAME' NE ”). 

OK 

JUMP IF SPECIFIED 

&NAME 

SETC 

•SAVEAREA' 


SET DEFAULT NAME 

.OK 

AN OP 




&CSECT 

CSECT 



DEFINE EXTERNAL SYMBOL 


STM 

14,12,12(15) 


SAVE CALLERS REGS 


BALR 

&BASE,0 


GET ADDRESSIBILITY 


US 1 NG 

*,&BASE 


TELL ASSEMBLER 


LR 

10,13 


SAVE POINTER TO CALLERS SA 


LA 

13,&NAME 


POINT TO CURRENT SA 


ST 

13,8(0,10) 


PLANT LINK TO CURRENT SA 


ST 

10,4(0,13) 


PLANT LINK TO HIGHER SA 


B 

*♦76 


BRANCH AROUND SAVEAREA 

&NAME 

DC 

18A(0) 


ALLOCATE SAVEAREA 

A 

MEND 





MACRO 



TEST FOR SUCCESSFUL OPEN 

5L 

TOPEN 

&DCB,&AD0R 


DCB ADDR / BRANCH ADDR 

&L 

TM 

&DCB+48,X'10' 


TEST OPEN BIT 


BO 

&AD0R 


TAKE BRANCH IF OPEN 


MEND 





PRINT 

NOGEN 



RDNASA 

LINKS 




**************************************************************** 

ir 

☆ 

SUBROUTINE RDNASA (DATA, 

lEOT) * 

A 

w 

* DATA 

— OUTPUT HALFViORD ARRAY 

USED BY FORTRAN PROGRAMS. * 

* 1 EOT 

-- SET 

TO ONE ON END OF 

FILE 

READS. * 

* NASA 

— DDNAME FOR INPUT DATASET. 

* 

k 

k 

A 


PROGRAM FUNCTION 

* 

W 

* THIS 

ROUTINE 

READS SPECTRUM DATA 

RECORDS IN THE 1969 NASA * 

* FORMAT (SEE 

DSECT). IT MOVES 

THE 

RAW DATA INTO THE * 

* MA 1 N 

PROGRAM 

BUFFER AND CLIPS 

THE 

FIRST TWO SPECTROMETER * 


* POINTS. THE CLIP IS TO CORRECT FOR THE TV>/0 COUNTER POINT * 

* ASYMMETRY BETV/EEN UP AN^ DOWN RAMP RECORDS. * 

☆ ♦ 


* 

•St 


UP 

DOWN 


RAMP 

RAMP 


LEADING DATA POINT 


k 

k 

k 


k k 

kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 





DATA 

EQU 

2 


1 EOT 

EQU 

3 

VALUE OF lEOT 

AIEOT 

EQU 

4 

ADDRESS OF 1 EOT 


L 

DATA, 0(0,1) 

GET BASE ADDRESS OF DATA 


L 

AIEOT, 4(0,1) 

GET ADDRESS OF lEOT 


SR 

1 EOT, 1 EOT 

SET DEFAULT ZERO 

w 

TOPEN 

NASA, READ 



OPEN 

NASA 

ATTEMPT TO OPEN 


TOPEN 

NASA, READ 



WTO 

'RSLIOOI NASA 

DD CARD MISSING' 


ABEND 

20 


READ 

GET 

NASA 

LOCATE A RECORD 


LA 

1, 4(0,1) 

SKIP RECORD CONTROL WORD 


MVC 

0(NASAHDR,DATA) 

,0(1) MOVE ID HEADER 


MVC 

NASAUDR( REST, DATA ) , NASAHDR+4 ( 1 ) 


B 

DONE 


EOT 

CLOSE 

(NASA, REREAD) 



LA 

1 EOT,l 

SET END OF FILE INDICATOR 

DONE 

ST 

lEOT, 0(0, AIEOT) 

STORE IT 


L 

13,4(0,13) 



RETURN (14,12) 


NASA 

DCB 

DDNAME=NASA, DSORG=PS, RECFM=V, BLKS 1 ZE=NASABUFL+4, 



EODAD=EOT,MACRF 

=GL 


TITLE 

'NASA RECORD 

FORMAT' 

NASARECD 

DSECT 



MASARCW 

DS 

F 

RECORD CONTROL WORD 

MASAMISS 

DS 

X 

MISSION 

NASADAY 

DS 

X 

DAY 

NASALINE 

DS 

X 

LINE 

NASARUN 

DS 

X 

RUN 

NASASITE 

DS 

X 

SITE 

NASAUNUS 

DS 

X 

UNUSED 

NASAERR 

DS 

X 

ERROR INDICATOR 

NASARAMP 

DS 

X 

RAMP CODE 

NASATIME 

DS 

F 

TIME IN ELAPSED MSEC 

MASAHDR 

EQU 

♦-NASAMISS 

HEADER LENGTH 

NASASPCT 

DS 

90H 

SPECTROMETER DATA 

NASARAD 

DS 

9H 

RADIOMETER READING 


DS 

9H 

CALIBRATION DATA 


DS 

9H 

CALIBRATION DATA 


DS 

2H 

CALIBRATION DATA 


DS 

6H 

REMAINDER 

NASALEN 

EQU 

♦-NASAMISS 

RECORD LENGTH 

NASABUFL 

EQU 

*-NASARCV/ 

BLOCK LENGTH 

REST 

EQU 

*-(NASASPCT+4) 




STANDRD 

TITLE 

DSECT 

'STANDARD 

FORMAT USED BY TASK/ PREP/ PROC ' 

STDRCW 

DS 

F 

RECORD CONTROL WORD 

STDMISS 

DS 

X 

MISSION 

STDDAY 

DS 

X 

DAY 

STDUNE 

DS 

X 

LINE 

STDRUN 

DS 

X 

RUN 

STDSSTE 

DS 

X 

SITE 

STDUNUS 

DS 

X 

UNUSED 

STDERR 

DS 

X 

ERROR INDICATOR 

STDRAMP 

DS 

X 

RAMP CODE 

STDTIME 

DS 

F 

TIME IN ELAPSED MILLISECONDS 

STDDUMMY 

DS 

F 

TASK PROCESSING HISTORY 

STDSPECT 

DS 

88F 

FLOATING POINT SPECTRAL DATA 

STDRAD 

DS 

3 5H 

INTEGER RADIOMETER. DATA 

STOLEN 

EQU 

END 

*-STDMISS 

RECORD LENGTH 


2.5 Subrout i ne Unpack 
UNPACK LINKS 


L 

R2,0(0,R1) 

POI NT TO FIRST ARG 

L 

R3,4(0,R1) 

POINT TO SECOND AR 

L 

R4,8(0,R1) 

POINT TO THIRD ARG 

LH 

R5,0(0,R2) 

PICK UP FIRST ARG 

N 

R5,=X'000000FF' 

GET A BYTE 

STH 

R5,0(0,R4) 

STORE THIRD ARG 

LH 

R5,0(0,R2) 

PICK UP FIRST ARG 

N 

R5,=X'0000FF00' 

GET A BYTE 

SRL 

R5,8 

ALIGN IT 

STH 

R5,0(0,R3) 

STORE SECOND ARG 

L 

R13^4(0,R13) 

SCRAM 

RETURN 

(14,12) 


COPY 

REGS 


END 





2.6 Subroutine Pater 


TITLE 'PATER — ZELLER"S CONGRUENCE FOR PAY OF THE V/EEK' 
PRINT NOGEN 

PATER LINKS 

* 


* * 

* SUBROUTINE DATER (AREA) -- RETURNS DAY, DATE, AND TIME ♦ 

* * 

AREA MUST CONTAIN 20 BYTES. * 

« ♦ 

WORD 1 THREE CHARACTER DAY OF THE WEEK ♦ 

* ViORD 2/5 »- DATE IN THE FORM MM/DD/YY * 

MORD 4/5 -- TIME OF DAY IN THE FORM (HH:MM) * 

He ♦ 

* THIS IS AN ADAPTATION OF ZELLER’S CONGRUENCE ♦ 

♦ 




* 

SLASH 

EQU 

C'/' 

CHARACTER CONSTANTS 

LPAR 

EQU 

C'( • 


RPAR 

EQU 

O' 


COLON 

EQU 

C':' 


BLANK 

•Ct 

EQU 

C * 


L 

1,0(0, 1) 

GET AREA APORESS 


LR 

3,1 

SAVE AREA APORESS 


USING 

RETURN, 3 

TELL ASSEMBLER 


TIME 

PEC 


Wb 

STM 

0,1, SAVE 

SAVE TIME ANP PATE 

W 

UNPK 

RHOUR(3),TIMEHH(2) 

UNPACK TIME 


UNPK 

RMIN(3),TIMEMM(2) 

UNPACK TIME 


MVI 

RTI ME, BLANK 



MVI 

RLPAR, LPAR 



MVI 

RCOLOM, COLON 



MVI 

RRPAR,RPAR 



EJECT 

XC 

TIME, TIME 

SET HIGHORDER BYTES TO ZERO 


CVB 

5, SAVE 

CONVERT YY.PPD TO BINARY 


SR 

4,4 

CLEAR FOR PIVIOE 


0 

4,C1000 

R4 = OOP R5 = YY 


EX 

5,TESTLEAP 

TEST FOR LEAP YEAR 


BNZ 

* + 10 

SKIP IF NOT LEAP YEAR 


MVC 

MCONS+2(2),LEAPFEB 

MOOIFY FOR LEAP YEAR 


SR 

6,6 

SET TO FI MO MONTH 

LOOP 

5H 

4,MCONS(6) 

SUBTRACT UNTIL NOT PLUS 


BNP 

OVER 

MONTH FOUNO 


LA 

6, L'MCONS(0,6) 

POINT TO NEXT MONTH COUNT 


B 

LOOP 

CONTINUE SEARCH 


3 * 1 . 



OVER 


* 


AH 

4^MCONS(6) 

SRL 

6,1 

CH 

6, Cl 

BH 

* + 6 

BCTR 

5,0 

LR 

9,5 

SR 

8,8 

D 

8,C4 

LR 

8,6 

AR 

8,8 

AH 

9,ZCOMS(8 ) 

AR 

9,4 

AR 

9,5 

AH 

9,CENT1 

SH 

9,CENT2 

SR 

8,8 

LA 

9,777(,9) 

D 

8,C7 

AR 

8,8 

AR 

8,8 

LA 

8,DAYMAME(S) 

MVC 

RDAYWEEK,0(8) 

UNPK 

RDAY(3),DATEYEAR(2) 

MVC 

RYEAR,RDAY 

MVI 

RSLASH2, SLASH 

CVD 

4, SAVE 

UNPK 

RDAY“l(3),SAVE+6(2) 

01 

RDAY+1,X'F0' 

MVI 

RSLASHl, SLASH 

LA 

6, 1(0, 6) 

CVD 

6, SAVE 

UNPK 

RMONTH-l(3),SAVE+6(2 

01 

RMONTH+1,X'FO' 

MVI 

RMONTH-1, BLANK 

L 

13,4(0,13) 

RETURN 

(14,12),T,RC=0 


ADJUST DAY OF MONTH NUMBER 
MONTH NUMBER IN R6 (0-11) 
TEST FOR JAN OR FEB 
THIS IS REQUIRED BY ZELLER 
DECREASE YEAR BY 1 
PUT YEAR (0-99) IN R9 
CLEAR FOR DIVIDE 
FIND FLOOR (YEAR/ 4) 

MONTH NUMBER IN R8 
NEED HALFV/ORD OFFSET 
ADD FIRST AND FOURTH TERM 
ADD DAY (1-31) 

ADD IN YEAR (0-09) 

ADD FIRST CENTURY TERM 


IM CASE OF NEGATIVE SUM 
FIND DAY OF THE WEEK 
MEED FULLWORD OFFSET 
DO IT THE PL/1 WAY 
GET ADDRESS OF DAY NAME 
PLANT IM RETURN AREA 

UNPACK YEAR (0-99) 

MOVE TO CORRECT AREA 
MOVE IN SLASH 
GET DAY INTO PACKED DEC 
UNPACK DAY OF THE MONTH 
STICK IN VALID ZONE 
MOVE IN SLASH 
USE ONE-ORIGIN MONTH 
GET MONTH INTO PACKED DEC 
) UNPACK MONTH OF THE YEAR 
STICK IN VALID ZONE 
CLEAR UNPK GARBAGE 


RETURN TO CALLER 





SAVE 

DS 

OD 

TIME MACRO SAVED HERE 

TIME 

DS 

OF 


TIMEHH 

DS 

PLl 


TlMEMfl 

DS 

PLl 


TIMEREST 

DS 

PL2 


DATE 

DS 

PLl 

MUST BE LOW HALF OF DBLE WD 

DATEYEAR 

DS 

PLl 


DATEDAY 

DS 

PL2 


DAYNAME 

DC 

C'SUN MON TUE WED THR 

FRI SAT ' 

ZCONS 

DC 

AL2(28, 31^2^5, 7, 10^12, 

15,18^20,23,25) 

MCONS 

DC 

AL2(31^28,31^30,31,30, 

31,31,30,31,30,31) 

LEAPFEB 

DC 

AL2(29) 


CENTURY 

EQU 

19 

ASSUME CURRENT CENTURY 

CENTl 

DC 

Y(CENTURY/4) 

FLOOR CENTURY/4 

CENT2 

DC 

Y(2*CENTURY) 


Cl 

DC 

Y(l) 


C4 

DC 

A(4) 


C7 

DC 

A(7) 


CIOOO 

DC 

A(IOOO) 


TESTLEAP 

Tr4 

BYTE,0 

EXECUTE FOR LEAP YEAR TEST 

BYTE 

DC 

X'03' 

TEST LOW ORDER TWO BITS 


TITLE 

•return AREA FORMAT' 


RETURN 

DSECT 


SAT 01/16/71 (15:25) 

RDAYWEEK 

DS 

CL4 

SAT 

RMONTH 

DS 

CL2 

01 

RSLASHl 

DS 

CLl 

/ 

RDAY 

DS 

CL2 

16 

RSLASU2 

DS 

CLl 

/ 

RYEAR 

DS 

CL2 

71 

RTIME 

DS 

CLl 


RLPAR 

DS 

CLl 

( 

RHOUR 

DS 

CL2 

15 

RCOLON 

DS 

CLl 

• 

• 

RMIN 

DS 

CL2 

25 

RRPAR 

DS 

CLl 

) 


END 





oooooooooooooooooooooooonoooooooooooooooo 


5.1 


Program Proc 


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 


PROGRAM PROC — SEPTEMBER 1970 
STANFORD REMOTE SENSING LABORATORY 


THIS PROGRAM READIES SELECTED IR SPECTRA FOR STATISTICAL 
ANALYSIS. THE DATA ARE RATIOED TO A BLACKBODY, NORMALIZED 
AND INVERTED. INDIVIDUAL AND AVERAGED SPECTRA ARE SAVED 
IN CARD IMAGE FORMAT ON SEPARATE FILES AFTER PROCESSING. 
ALTHOUGH THERE MAY BE ANY NUMBER OF INPUT DATASETS^ ALL 
OUTPUT APPEARS ON TWO DATASETS, ONE FOR INDIVIDUALS AND 
ONE FOR COMPOSITES. 


DDNAMES REQUIRED 

FT05F001 -- INPUT CONTROL CARDS. 

FT06F001 -- OUTPUT MESSAGES, TABLES, AND PLOTS. 
FT07F001 — OUTPUT FILE FOR INDIVIDUAL SPECTRA 
FT08F001 — OUTPUT FILE FOR AVERAGED SPECTRA 
FTNNFOOl — INPUT DATASETS 

FT99F001 — INPUT BLACKBODY REFERENCE SPECTRUM 


RECORD FORMATS 

A. INPUT SPECTRA MUST BE IN "STANDARD" FORMAT. THIS MEANS 
THAT THE DATA WAS PRODUCED BY EITHER TASK OR PREP. 

B. THE BLACKBODY DATA MUST BE PRE- AVERAGED AND IS USUALLY 
GENERATED BY PROGRAM AVERAGE AND SAVED ON DISK. 

C. CARD OUTPUT CONSISTS OF AN IDENTIFICATION CARD, 

FOLLOWED BY THE DATA IN 8F9.4 FORMAT. 

D. PRINTED OUTPUT CONSISTS OF LISTINGS AND PLOTS OF THE 
AVERAGED DATA AFTER PROCESSING. 

E. THE CONTROL CARDS CONTAIN A UNIT NUMBER IN COLUMNS 4 AND 5 
AND A DESCRIPTIVE NAME FOR THE DATA IN COLUMNS 31 - 70. 
THIS FORMAT IS THE SAME AS THAT USED BY PREP. 


OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO 



ooo oooooooooooor^oo o o ooooooooooo 


NAMELIST PARAMETERS 

THESE VARIABLES MAY BE ALTERED USING THE &PARMS NAMELIST. 
THE NAMELIST MUST BE PRESENT AND MUST BE THE FIRST DATA 
IN THE INPUT STREAM. IT IS FOLLOWED BY A CARD CONTAINING 
A DESCRIPTION OF THE PROCESSING, WHICH APPEARS ON THE 
PRINTED OUTPUT. AFTER THIS COMES THE CONTROL CARDS. 


VARIABLE 1 FUNCTION | DEFAULT 


PSZ 

1 PLOT WIDTH 

2.n 

SMOOTH 

1 SMOOTHING SWITCH 

.TRUE. 

ICARDS 

1 INDIV CARDS SWITCH 

.TRUE. 

ACARDS 

1 AVERAGE CARDS SWITCH 

.TRUE. 

LIST 

1 DATA LISTING SWITCH 

.TRUE. 

PLOT 

1 PLOT SWITCH 

.TRUE. 

SMTYPE 

1 SMOOTHING TYPE 

-9 

BODY 

1 BLACKBDDY UNIT ilO. 

9D 

NCLIP 

1 NO. OF POINTS CLIPPED 

18 

CNT 

1 INITIAL SEQUENCE NO. 

91 

CARD 

1 CONTROL INPUT UNIT 

5 


INTEGER CARD/5/, PRINT/6/, IOUT/7/, AOUT/8/, BODY/99/, DATE(5) 
INTEGER CNT/91/, NCLIP/18/, SMTYPE/-9/, IER/0/ 

INTEGER NAME(8), HEAD(2), TIME, DISK, HMS(3), HMS2(3), DES(18) 
REAL RAW(88), ASP(88), SSP(88), DSK(92), BLB(92), PSZ/2.0/ 
EQUIVALENCE (DSK(l), HEAD(D), (DSK(3), TIME) 

LOGICAL*! SMOOTH/. TRUE./, I CARDS/ . TRUE ./ , ACARDS/ . TRUE . / , 

* LIST /.TRUE. /, PLOT /.TRUE./ 


DEFINE NAMELIST PARAMETERS 

NAMELIST /PARMS/ PSZ, SMOOTH, ICARDS, ACARDS, LIST, PLOT, 
* SMTYPE, BODY, NCLIP, CMT, CARD 

C 

C READ NAMELIST PARAMETERS 

READ (CARD, PARMS) 

WRITE (PR I NT, PARMS) 

C 

C SET PARAMETERS 

CNT = CNT + NCLIP 
NMAX = 88 “ 2*NCL!P 




0000000000000 0 00(^00000000 



C READ DESCRIPTOR 

READ (CARD, 52) DES 
WRITE (PRINT, 53) DES 
C 

C GET DAY DATE & TIME 

CALL DATER (DATE) 

C 

C READ & CLIP BLACKBODY, IGNORE FOUR WORD HEADER 

READ (BODY) BLB 
DO 12 I = 1,NMAX 

12 BLB( I ) = BLB( 1+4+NCLIP) 

C 

C 

C READ CONTROL CARD 

15 READ (CARD,51, END=44) DISK, NAME 

C 

DO 10 I = 1,NMAX 
ASP( I ) =0.0 
SSP( I ) =0.0 
10 CONTINUE 

C 

C READ AND PROCESS SPECTRA 

DO 30 I = 1,10000 
READ (DISK, END=31) DSK 
IF ( I . EQ. 1) ITIME = TIME 
C 

C CLIP SPECTRUM, IGNORE FOUR WORD HEADER 

DO 13 J = 1,NMAX 

13 RAW(J) = DSK(J+4+NCLI P) 

C 

C RATIO SPECTRUM 

DO 26 J = 1,NMAX 

26 RAW(J) = RAW(J) / BLB(J) 

C 

C SMOOTH SPECTRA 

IF (SMOOTH) CALL SM (RAW, NMAX, I ER, SMTYPE) 

IF (lER .EQ. 0) GOTO 17 
WRITE (PRINT, 67) 

STOP 

C 

C NORMALIZE SPECTRUM 

17 CALL NORM (RAW, NMAX) 

C 

C INVERT SPECTRUM 

DO 27 J = 1,NMAX 

27 RAW(J) = -RAW(J) 





O O O 


C SUM RESULT 

DO 25 J = l^NMAX 
ASP(J) = ASP(J) + RAW(J) 

SSP(J) = SSP(J) + RAVKJ) ** 2 

25 CONTiHUE 

C 

C OUTPUT INDIVIDUAL SPECTRUM 

CALL XLATE (TIME, HMS) 

IF (ICARDS) WRITE (IOUT,71) HEAD, HMS, NAME, I , ( RAW( J ) , J=1 , NMAX ) 

0 CONTINUE 

EOF ON SPECTRUM INPUT 
31 NSPECT =1-1 

IF (NSPECT ,LT. 2) WRITE (PRINT, 69) NAME 
IF (NSPECT .LT. 2) GOTO 15 
CALL XLATE (ITIME, HMS2) 

C 

C PRINT RESULTS 

IF (LIST) WRITE(PRINT,62) NAME , HEAD, DATE, NSPECT, HMS2 , HMS , DES 
IF (LIST) CALL TABLE (ASP, SSP, NMAX, NSPECT, CNT, PRINT, 

* 'STANDARD') 

C 

C PLOT RESULTS 

IF (PLOT) WRITE(PRINT,62) NAME , HEAD, DATE, NS PECT, HMS2 , HMS, DES 
IF (PLOT) CALL SPLOT (ASP, SSP, -PSZ, PSZ, PRINT, NMAX, CMT) 

C 

C OUTPUT AVERAGED SPECTRUM AND STANDARD DEVIATION 

IF (ACARDS) WRITE (AOUT,71) HEAD, HMS2, NAME, NSPECT, 

* (ASP( J), J=1,NMAX) 

IF (ACARDS) WRITE (AOUT,71) HEAD, HMS, NAME, NSPECT, 

* (SSP(J), J=1,NMAX) 

C 

C READ NEXT CONTROL CARD 

GOTO 15 
C 

C NO MORE CONTROL CARDS EXIT 

44 WRITE (PRINT, 66) 

STOP 


15 ^ 



51 F0RMATC3X, I2,T31,10A4) 

52 FnRMAT(20A4) 

53 FORMAK 'ORSLOOO I ',20A4) 

5 7 FORMAK FK3. 3) 

62 FORMAK//// ' lUP RAMP SPECTRUM GROUP CALLED -- 

* 5A4/' iJUKBER OF SPECTRA IN GROUP: ',13/ 

* ' RECORDED FROM ' , 2 I 3 , I 6, ' TO ',2 I 3, 16,' 

66 F0RMAT(/////'1RSL001I NORMAL END OF RUN') 

67 FORMAT( ' IRSLOIO I SMOOTHING PARAMETER INVALID' 

69 FORMAT(/////'1RSL020| I NSUFF I C I ENT RECORDS -- 

* ' RSL020I ',8A4) 

C 

C THIS IS THE CARD OUTPUT FORMAT 

71 FORMAT(2Z10,1X,2I3, I6,1X,8A4, I4/(8F9.4)) 

END 


3 o 2 Sub rout i ne Mo rm 


SUBROUTINE NORM (A, N) 

REAL A(N) 

SUM =0.0 
SQS = 0.0 
DO 10 I = 1,N 
SUM = SUM + A(l) 

SOS = SQS + A( I ) ** 2 
10 CONTINUE 

EN = N 

SQS = SQRT ((SQS - SUM ** 2 / EN) / ( EN - 1.0) 
SUM = SUM / EN 
DO 20 I = 1,N 
A( I ) = (A( I ) - SUM)/SQS 
20 CONTINUE 

RETURN 
END 



' ,8A4,5X,2Z10,8X, 
. '/1X,18A4/) 

) 

GROUP BYPASSED'/ 



3 . 5 Subrout i ne Sm 


SUBROUTINE SM (NDATA^ I ER, NMP) 

C 

C SMOOTHING SUBROUTINE WRITTEN BY J.R. MOORE 
C 

C NDATA= INPUT SPECTRUM & OUTPUT SMOOTHED SPECTRUM 

C N=NUMBER OF POINTS 

C IER=ERROR MESSAGE--0 IF OK, -1 IF NOT 

C NMP=SMOOTHING TYPE 

REAL NDATA(100),MDATA(100),NP(20) 
IF(N.GT.100.0R.NMP.LT.-20.0R.NMP.GT.20) GO TO 900 
NNP=NMP 

IF(NMP.LT.O)NNP=-NMP 

NXP=NNP 

IF(NMP.EQ.-l) NNP=3 

MM=NNP-1 

M=N-MM 

DO 20 1=1, N 

20 MDATA( l) = NDATA( 1 ) 

DO 10 1=2, NNP 
J=l-1 

10 NP( I )=NDATA(J) 

DO 200 l=l,M 
J=I+MM 

DO 11 K=1,MM 
KA=K+1 

11 NP(K)=NP(KA) 

NP(NNP)=NDATA(J) 

IF(NMP.LT.O) GO TO 100 

GO TO (300,900,900,900,101,900,102,900,103,900,104,900, 
1401,900,900,900, 402),NNP 

101 SUM=17*NP(3)+12*(NP(2)+NP(4))-3*(NP(1)+NP(5)) 

MDATA( l+2)=SUM/35 
GO TO 200 

401 SUM=NP(1)+NP(2)+NP(3)+NP(4)+NP(5)+NP(6)+NP(7)+NP(8)+NP(9)+ 
1NP(10)+NP(11)+NP(12)+NP(13) 

MDATA( l+6)=SUM/13 
GO TO 200 

402 SUM=-21*(NP(1)+NP(1'^))-6*(NP(2) + NP(16)) + 7*(MP(3)+NP(15)) + 
118*(NP(4)+NP(14))+27*(NP(5)+NP(13))+34*(NP(6)+NP(12))+ 
139*(NP(7)+NP(11))+42*(NP(8)+NP(10))+43*NP(9) 

MDATA( l+8)=SUM/323 
GO TO 200 

SUM=195*(NP(1)+NP(17))-195*(NP(2)+NP(16))-260*(NP(3)+NP(15))- 
1117*(NP(4)+NP(14))+135*(NP(5)+NP(13))+415*(NP(6)+NP(12))+ 
2660*(NP(7)+NP(11))+825*(NP(8)+NP(10))+883*(MP(9)) 


403 



MDATA( l+8)=SUM/4199 
GO TO 200 

102 SUM=-2*(tJP(l)+NP(7)) + 3*(NP(2) + NP(6) ) + 6*(NP(3)+NP(5) ) + 7*NP(4) 
MOATA( l+3)=SUM/21 

GO TO 200 

103 SUM=-21*(r.'P(l) + NP(9))-«-14*(N'P(2)+NP( 8) )+39*(NP(3)+NP(7)) + 
154*(NP(4)+NP(6) )+59*NP(5) 

MDATA( l<-4) = SUM/231 
GO TO 200 

300 5l!M=riP(l)+HP(2)+MP(3) 

I1DATA( l-H) = SUM/3 
GO TO 200 

104 SUM=-3G*(NP(l)+nP(ll)) + 9*(NP(2)+r!P(10)) + 44*(NP(3)+NP(9)) + 
169*(fiP(4) + riP(8) ) + 84*(NP(5)+MP(7) ) + 89*fJP(6) 

nOATA( l+5)=SUM/429 
GO TO 200 
100 COMTIMUE 

GO TO (300,900^900,900,101,900,106^900,107,900,108, 
1900,900,900,900,900,403),NXP 

106 SUM=5*(NP(1)+MP( 7))-30*(NP(2)+NP(6) )+75*(MP(3)+MP(5) )+131*NP(4) 
MDATA( l+3)=SUM/231 

GO TO 200 

107 SUM=15*(NP(1)+NP(9))-55*(HP(2)+NP(8))+30*(NP(3)+MP(7))+ 
1135*(NP(4)+NP(6) )+179*MP(5) 

MDATA( l+4)=SUM/429 
GO TO 200 

108 SUM=18*(NP(1)+NP(11))-45*(NP(2)+NP(10))-10*(NP(3)+MP(9))+ 
160*(NP(4)+NP(8) )+120*(MP(5)+NP(7))+143*MP(6) 

MDATA( l+5)=SUM/429 
200 CONTINUE 
C 

C RETURN MDATA IN NDATA 

DO 500 I = 1,N 

500 NDATA( I ) = MOATA( I ) 

I ER=0 
RETURN 
900 IER=-1 

RETURN 
END 


V/ 



ooooooonooooooooooo 


4 . 1 Program D I scard 


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
PROGRAM DISCARD 

DELETE TRAINING SPECTRA WHOSE DISTANCE FROM THE GROUP 
MEAN IS UNACCEPTABLE 


DDNAME 

PURPOSE 

1 

VARIABLE NAME 

FT06F001 

LISTING FILE 

1 

PRINT 

FT05F001 

CONTROL CARD FILE 

1 

CARD 

FTlOFOOl 

OUTPUT SPECTRA FILE 

1 

OUTPUT 

FT03F001 

INDIVIDUAL SPECTRA INPUT FILE 

1 

INDIV 

FT04F001 

AVERAGE SPECTRUM INPUT FILE 

1 

AVER 


THE ABOVE DDNAMES MAY BE ALTERED USING THE &PARMS NAMELISTC 
AND THE REJECTION LEVEL IS ENTERED BY GIVING "LIMIT" C 

A VALUE IN THE NAMELIST. A NAMELIST IS READ FOR EACH GROUPC 

C 

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

c 

INTEGER PRINT/6/^ CARD/5/, OUTPUT/10/, INDIV/3/, AVER/4/ 
INTEGER FLAG, NAME(8), TIME(3) 

REAL SPECT(52), ASP(52), LIMIT 
REAL*8 WORD(2) /' REJECTED ' / 

C 

C DEFINE NAMELIST 

NAMELIST /PARMS/ LIMIT, PRINT, CARD, OUTPUT, INDIV, AVER 
C 

C READ NAMELIST 

10 READ (CARD, PARMS, END=88) 

C 

C READ NAME, NUMBER OF SPECTRA, AVERAGE SPECTRUM 

READ (AVER,51, END*88) NAME, NSPEC, ASP 
WRITE (PR I NT, 61) NAME 


V2. 


ooooooooooooooo 



C READ INDIVIDUAL SPECTRA 
ICNT = 0 

DO 20 I = 1, NS PEC 

READ ( INDI V^52^ END=77) TIME, NAME, ISEQ, SPECT 
TALLY = 0.0 
DO 15 J = 1,52 

15 TALLY = TALLY ♦ (SPECT(J) - ASP(d)) ** 2 
C 

FLAG = 2 

IF (TALLY ,GT. LIMIT) GOTO 17 
C 

C WRITE ACCEPTABLE SPECTRUM 

WRITE (OUTPUT, 52) TIME, NAME, ISEQ, SPECT 

ICNT » ICNT + 1 
FLAG = 1 
C 

17 WRITE (PRINT, 63) ISEQ, TIME, TALLY, WORD(FLAG) 

20 CONTINUE 

C 

C GO READ NEXT GROUP 

WRITE (PRINT, 62) LIMIT, ICNT 
GOTO 10 
C 

C NORMAL END OF FILE EXIT 

88 WRITE (PRINT, 66) 

STOP 

C 

C ERROR END OF FILE EXIT 

77 WRITE (PRINT,67) 

STOP 

C 

51 FORMAT (T35,8A4,T68, I 3/6(8F9.4/),4F9.4////////) 

52 FORMAT ( T22, 2 I 3, I b, T35, 8A4, T68, I 3/ ( 8F9 . 4 ) ) 

61 FORMAT (1H1,T15,8A4,T48, 'TIME', T58, 'DISTANCE', T69, 'DECISION'/) 

62 FORMAT ( ///T40, ' TOLERANCE ', F5. 0, ' LEAVES', 13,' SPECTRA.') 

63 FORMAT (T38, 14, ')', I4,1X, 12, I6,F10.4,3X,A8) 

66 FORMAT ClRSLOOll NORMAL END OF RUN') 

67 FORMAT C1RSL145I UNEXPECTED END OF FILE') 

END 






cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 


c c 

C PROGRAM TRKLOAD — TRUCK TAPE TO DISK C 
C C 
C THIS PROGRAM READS TRUCK TAPES AND CREATES TWO OUTPUT FILES. C 
C DATA RECORDS ARE STORED IN A DIRECT ACCESS DATASET^ AND C 
C IDENTIFICATION RECORDS ARE STORED IN A SEQUENTIAL DATASET C 
C WITH POINTERS TO THE CORRESPONDING DATA. C 

c c 

C SPECTAPE — DDNAME OF TRUCK TAPE. C 
C NO DCB PARAMETERS REQUIRED. C 
C DIRECT — DDNAME OF DATA OUTPUT FILE. C 
C DCB=(DSORG=DA,BLKSIZE=204) C 
C FTlOFOOl -- DDNAME OF IDENTIFICATION FILE. C 
C DCB=(RECFM=FB,LRECL=40,BLKSIZE=3520) C 
C FT06F001 — DDNAME OF IDENTIFICATION LISTING FILE. C 
C FT04F001 — DDNAME OF DATA LISTING FILE. C 
C FT05F001 — DDNAME OF PARAMETER INPUT FILE. C 
C &PARMS LIST=F, ERRCNT=10, TERR=F^ &END C 
C C 


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 

c 

IMPLICIT INTEGER*2 (A-Z) 

INTEGER KEY/1/, COUNT/0/, PRINT/6/, INDEX/10/, DUMP/4/, LRECL 
INTEGER ERRCNT/10/,CARD/5/,NERR/0/,NIDS/0/,NINV/0/,NREAOS/0/ 
INTEGER JUMP, DATE(5), I, J, K, L, M, N 
INTEGER DTLEN, IDLEN/20/, DTSIZ/48/ 

LOGICAL LIST /.FALSE./, TERR /.FALSE./ 

DIMENSION SAVEID(6) 

C 

C RDTRK COMMON DEFINITION 

COMMON /TDATA/ INPA(200), I DENT( 6 ) , SPECTC 48 ) , RAD I 0( 48 ) ,MULT( 6 ) 
C 

C DEFINE DIGITIZED (0,1023) TO DECIVOLTS (-100,100) FORMULA 
DVOLT(RAW) = (200*RAW - 102300) / 1023 
C 

C DEFINE AND READ NAMELIST 

NAMELIST /PARMS/ ERRC^'T, LIST, TERR 
READ (CARD, PARMS, END=2) 

2 CONTINUE 

C 

C INITIALIZE 

DTLEN = DTSIZ*4 + 12 

IF (TERR) CALL NOERR 
C 

CALL DATER (DATE) 

WRITE (PRINT, 65) DATE 
C 

ASSIGN 11 TO JUMP 



11 


c 


c 

12 

10 

c 

c 

20 

C 


C 

C 


C 

C 

30 

31 

32 
C 


C 


C 

49 


CALL RDTRK (LRECL) 

NREADS » NREADS ♦ 1 
IF (LRECL .EQ. IDLEN) GOTO 12 
IF (LRECL .LT. 0) GOTO 80 
IF (LRECL .EQ. 0) STOP 

BUFL » LRECL/2 

WRITE (PRINT^ei) NREADS^ LRECL^ (INPA(J)/ J = l^BUFL) 
NINV « NINV ♦ 1 
GOTO 11 

DO 10 I = 1^6 
SAVEID(I) * IDENT(I) 

SAVKEY = KEY 

READ INPUT TAPE 
ASSIGN 20 TO JUMP 
CALL RDTRK (LRECL) 

NREADS » NREADS + 1 

IF (LRECL .EQ. DTLEN) GOTO 30 
IF (LRECL .EQ. IDLEN) GOTO 40 
IF (LRECL .EQ. 0) GOTO 50 
IF (LRECL .LT. 0) GOTO 80 

BAD LRECL^ IGNORE RECORD 
NINV = NINV ♦ 1 
BUFL « LRECL/2 

WRITE (PRINT^Sl) NREADS, LRECL, (INPA(J), J = 1,BUFL) 
WRITE (PRINT, 67) 

GOTO 20 


DATA RECORD FOUND 

DO 31 M = 1,DTSIZ 

SPECT(M) = DVOLT(SPECT(M)) 

RADIO(M) = DVOLT(RADIO(M)) 

DO 32 M = 1,6 

MULT(M) = DVOLT(MULT(M)) 


CALL DALOAD (SPECT, KEY) 
IF (.NOT. LIST) GOTO 49 


WRITE (DUMP, 72) KEY, (SPECT(N), N = 1,DTSIZ) 
WRITE (DUMP, 73) <:RADI0(N), N = 1,DTSIZ) 
WRITE (DUMP, 74) MULT 


KEY = KEY + 1 
COUNT = COUNT ♦ 1 
GOTO 20 





C IDENTIFICATION RECORD FOUND 

40 IF (COUNT .NE. 0) GOTO 47 

C 

C IDENTIFICATION RECORD CONTAINS NO DATA 

WRITE (PRINT^62) SAVEID 
NINV = NINV + 1 
GOTO 45 
C 

C WRITE IDENTICATION RECORD 

47 . NIDS = NIDS + 1 

WRITE (INDEX, 66) SAVEID, SAVKEY, COUNT 
WRITE (PRINT, 64) NIDS, SAVEID, SAVKEY, COUNT 
SAVKEY = KEY 
COUNT = 0 
C 

45 DO 46 I = 1,6 

46 SAVEID(I) = IDENT(I) 

GOTO 20 

C 

C END OF FILE EXIT 

50 IF (COUNT .NE. 0) GOTO 48 

C 

C IDENTIFICATION RECORD CONTAINS NO DATA 

WRITE (PRINT, 62) SAVEID 
NINV = NINV + 1 
GOTO 60 
C 

C WRITE FINAL IDENTIFICATION RECORD 

48 NIDS = NIDS + 1 

WRITE (INDEX, 66) SAVEID, SAVKEY, COUNT 
WRITE (PRINT, 64) NIDS, SAVEID, SAVKEY, COUNT 


(4^ 



60 


C 

C 

80 


C 

C 


C 

61 

62 


63 


64 

65 

66 
67 
69 

71 

72 

73 

74 


NREADS = NREADS - 1 
KEY = KEY - 1 

WRITE (PRINT^63) NREADS, NIDS, KEY, NINV, NERR 

IF (LIST) WRITE (DUMP, 63) NREADS, NIDS, KEY, NINV, NERR 

STOP 

READ ERROR ROUTINE 

WRITE (PRINT, 69) NREADS, (INPA(J), J = 1,160) 

NERR = NERR + 1 

IF (NERR .LE. ERRCNT) GOTO JUMP, (11, 20) 


TOO MANY ERRORS 

WRITE (PRINT, 71) NREADS 

STOP 


* 


* 


FORMAT(///' RSL042I RECORD', 15,' I NVAL I D ' , I 4, ' BYTES'// 

(• RSL042I ',1BZ6)) 

FORMAT(///' RSL040I IDENTIFICATION RECORD CONTAINS NO DATA'// 
' RSL040I DAY IS ',19/ 

' RSL040I TIME IS ',313/ 

' RSL040I SAMPLE IS', 19/ 

' RSL040I SITE IS ',19///) 

FORMATC IRSLOOOI ', 16, ' RECORDS READ'/ 

' RSLOOO I ' , I 6, ' IDENTIFICATION RECORDS SAVED'/ 

' RSLOOOl ', IG, ' DATA RECORDS SAVED'/ 

' RSLOOOl ', 16, ' INVALID RECORDS FOUND'/ 

' RSLOOO I ', 16, ' PERMANENT READ ERRORS'// 

' RSLOOll NORMAL END OF RUN') 

FORMAT(T15, 14, ' ) DAY =',I4,'; TIME =',313,'; SAMPLE =', 
14,'; SITE =',I4,'; START =',I5,'; COUNT =',I3) 
FORMAT('l',T35, 'IDENTIFICATION RECORDS SAVED ON ',5A4//) 
FORMAT(8 I 5) 

FORMAT(////) 

FORMAT(///' RSL044I RECORD NO', 15,' PERMANENT READ ERROR'// 
lOC RSL044I ',167.6/)///) 

FORMAT(///' RSL046I I/O ERROR COUNT EXCEEDED ',15, 

' RECORDS READ') 

FORMATC l',T32, 'RECORD NO. ',15///' SPECTROMETER DATA' // ( 8 I 10 ) ) 
FORMATC////' RADIOMETER DATA ' // ( 8 1 10 ) ) 

FORMAT(////' MULTIPLEXED DATA'//6I10) 


END 


wf 



5.2 


Subroutine Rdtrk 


TITLE 'SG-4 SPECTROMETER TAPE READ ROUTINE' 


* 



MACRO 


&L 

BCD 

&TO,&FROM 

&L 

LH 

TEM2^&FROM 


SLDL 

TEMP, 2 4 


SRL 

TEM2,26 


LA 

BCD,X'F* 


NR 

BCD, TEMP 


MH 

BCD,=Y(100) 


AR 

BCD,TEM2 


LH 

TEM2,&FROM 


SR 

TEMP, TEMP 


SLDL 

TEMP, 20 


SLL 

TEM2,10 


SRL 

TEM2,28 


OR 

TEMP,TEM2 


MH 

TEMP,»Y(10) 


AR 

BCD, TEMP 


STH 

MEND 

BCD,&TO 


* 


* 


* 

MACRO 


&L 

TENBIT 

ATO,&FROM 

&L . 

LH 

TEM2,&FROM 


SLDL 

TEMP, 51 


SRDL 

TEMP, 27 


SRL 

TEM2,19 


OR 

TEMP,TEM2 


STH 

MEND 

TEMP,&TO 


CONVERT FROM PACKED BCD 
TO HALFWORD INTEGER 
PICK UP BCD HALFWORD 
SEPARATE BYTES 
GET UNITS DIGIT 
LOAD MASK 

GET HUNDREDS DIGIT 
SCALE 

ADD UNITS DIGIT 
PICK UP BCD HALFWORD 
CLEAR TEMP 

GET RIGHT HALF OF TENS DIGIT 

GET LEFT HALF OF TENS DIGIT 

ALIGN LEFT HALF 

PUT HALFS TOGETHER 

SCALE 

SUM 

STORE HALFWORD RESULT 


CONVERT FROM SG CODE TO 1*2 

TO/FROM ARE HALFWORDS 

PICK UP DATA 

GET RID OF SYNC BIT 

ALIGN 

ALIGN 

PUT TOGETHER 
STORE CONVERTED DATA 






MACRO 


WRITE TO OPERATOR MACRO 

&L 

WTOP 

&ARG^&MF=^&LIMIT = 10 

WRITE LIMIT NUMBER OF TIMES 


LCLC 

&COUNT 



AI F 

C&MF' EQ 'L').LIST 

GO SET UP MESSAGE AREA 


AIF 

C&MF' EQ 'em. XEQ 

GO PRINT OUT MESSAGE AREA 


AGO 

. ERROR 

MACRO FORM ERROR 

.XEQ 

ANOP 
AI F 

C&ARG' EQ "). ERROR 

MESSAGE ADDR MUST BE GIVEN 

&COUNT 

SETC 

'CNT' . 'SSYSNDX' 

COUNTER NAME SYMBOL 

&L 

L 

1,&C0UNT 

PICK UP COUNT 


BCT 

1/ * + 8 

DECREMENT AND JUMP 


B 

&COUNT+4 

IGNORE WRITE REQUEST 


ST 

1,&C0UNT 

RESTORE COUNTER 


LA 

l,&ARG-4 

LOAD ARG LIST POINTER 


SVC 

35 

ISSUE WTO SVC 


B 

&COUNT+4 

JUMP COUNTER 

&COUNT 

DC 

MEXI T 

A(&LIMIT) 

SAVE COUNTER HERE 

.LIST 

ANOP 


DEFINE WTO MESSAGE AREA 


AIF 

C&L' EQ "). ERROR 

LABEL SYMBOL NEEDED 


AIF 

C&ARG' EQ "). ERROR 

BYTE COUNT NEEDED 


CNOP 

0.4 

GET ON A FULLWORD BOUNDARY 


DC 

AL2(&ARG+4) 

DEFINE MESSAGE LENGTH FOR OS 


DC 

AL2(0) 

REQUIRED BY OS 

&L 

DC 

MEXIT 

CL(.'^ARG)' ' 

ALLOCATE BLANK MESSAGE AREA 

. ERROR 

MNOTE 

8.'RSL200I PARAMETER 

INVALID -- NO CODE GENERATED' 


MEND 



SGNSIZ 

EQU 

10 


SGDSIZ 

EQU 

48 




PRINT NOGEN 
RDTRK LINKS 

******************************************************************* 
* * 

* SUBROUTINE RDTRK (LRECL) * 

* * 

* * 

* LRECL — SIZE IN BYTES OF CURRENT RECORD^ SET TO ZERO * 

* ON EOF READS. * 

* SPECTAPE — DDNAME FOR INPUT DATA SET * 

* TDATA — FORTRAN COMMON^ HALFWORD INTEGERS * 

* it 

♦COMMON /TDATA/ INPA(200), IDENT(6)^ SPECT(48)^ RADIO(48), MULT(6)* 

* * 

* ♦ 

* THIS FORTRAN CALLABLE SUBROUTINE READS AND CONVERTS DATA * 

* READ FROM 7-TRACK MAG TAPE GENERATED BY STANFORDS SG-4 * 

* SPECTROMETER SYSTEM. * 

* THE RAW DATA IS CONTAINED IN TWO DIFFERENT RECORD FORMATS * 

* EACH OF A DIFFERENT PHYSICAL LENGTH AND DATA RECORDING MODE* 

* THE IDENTIFICATION RECORD CONTAINS DATA IN A PACKED BCD * 

* FORMAT WHERE EACH PAIR OF SIX BIT BYTES CONTAIN THREE * 

* FOUR BIT BCD CHARACTERS. * 

* * 

* TAPE DATA FORMAT: OOIFGHIJ OOOABCDE * 

* CONVERTED FORMAT: OOOOOOAB CDEFGHIJ * 

* * 

* TAPE BCD FORMAT: OOEF IJKL OOABCD GH * 

* CONVERTED FORMAT: ABCD + 10*EFGH ♦ 100*1 JKL * 

* * 

* THE DATA IS RETURNED IN COMMON TO FORTRAN, ALL NUMBERS * 

* ARE CONVERTED TO 16 BIT TWOS COMPLIMENT INTEGERS. * 

* * 
******************************************************************* 
* 

L LRECL, 0(0, PARM) GET ARG ADDRESS 

SR COUNT, COUNT SET COUNT TO ZERO 

TITLE 'OPEN, READ, CLOSE SECTION' 

TOPEN SPECTAPE, READ 

OPEN (SPECTAPE) 

TOPEN SPECTAPE, READ 

WTO 'RSLIOOI SPECTAPE DD CARD MISSING' 

ABEND 20, DUMP 


READ 

READ 

DECB^SF^SPECTAPE, 

INPA, 'S' 


CHECK 

DECB 



LTR 

COUNT^ COUNT 

DID WE GET AN ERROR? 


BM 

EXIT 

IF SO EXIT 


L 

CBASE/=V(TDATA) 

ESTABLISH COMMON BASE REG 


USING 

INPA^CBASE 



BAL 

LINKR.BLKSIZE 

GET BLOCK BYTE COUNT 


C 

COUNT, =A(SGIDSIZ) 

CHECK FOR IDENT RECORD 


BE 

IDCONV 



C 

COUNT, =A(SGDTSIZ) 

CHECK FOR DATA RECORD 


BE 

DATACONV 



B 

EXIT 

RECORD LENGTH ERROR 

■C 

EODAD 

CLOSE 

(SPECTAPE, LEAVE) 

LEAVE FOR MULTI PLE FILES 

EXIT 

ST 

COUNT, 0(0, LRECL) 

RETURN LRECL TO FORTRAN 


L 

SAVER, 4(0, SAVER) 



RETURN 

(14,12) 



TITLE 

'IDENTIFICATION CONVERSION ROUTINE' 

IDCONV 

DS 

OH 



BCD 

DAY,SGDAY 



BCD 

TIMEH,SGTIME 



BCD 

TIMEM,SGTIME+2 



BCD 

SAMPLE, SGSAMPLE 



BCD 

SITE,SGSITE 



SR 

TEMP, TEMP 

FIX TIME 


LH 

TEM2, TIMEM 

LOAD LOWEST THREE DIGITS 


D 

TEMP, =F' 100 ' 

EXTRACT LOW ORDER TWO DIGITS 


STH 

TEMP, TIMES 

STORE SECONDS 


ST 

TEM2, CSAVE 

SAVE LOW ORDER MINUTES DIGIT 


LH 

TEM2,TIMEH 

LOAD HIGH ORDER THREE DIGITS 


SR 

TEMP, TEMP 

CLEAR EVEN REGISTER 


D 

TEMP, =F' 10' 

EXTRACT HIGH ORDER TWO DIGITS 


STH 

TEM2,TIMEH 

SAVE HOUR DIGITS 


MH 

TEMP, =H' 10' 

SCALE HIGH ORDER MINUTE DIGIT 


A 

TEMP, CSAVE 

ADD LOW ORDER MINUTE DIGIT 


STH 

TEMP, TIMEM 

SAVE MINUTES 


B 

EXIT 


CSAVE 

DS 

F 



r/ 




TITLE 

'DATA CONVERSION 

ROUTINE' 

DATACONV 

DS 

OH 



LA 

POINT^SGCHANLA 

CONVERT SPECT/RADIO DATA 


LA 

STEP, 4 



LA 

LIMIT, SGMULT-4 


ie 

SR 

INDEX, INDEX 


DLOOP 

DS 

OH 



TENBIT 

SPECT(INDEX),0(0, 

POINT) 


TENBIT 

RADIO(INDEX),2(0, 

POI NT) 


LA 

INDEX, 2(0, INDEX) 


it 

BXLE 

POINT, STEP, DLOOP 



LA 

LIMIT,6 

CONVERT MULTIPLEX DATA 


SR 

INDEX, INDEX 


MLOOP 

DS 

OH 



TENBIT 

MU LT(INDEX),SGMULT( INDEX) 


LA 

INDEX, 2(0, INDEX) 



BCT 

LIMIT, MLOOP 



B 

EXIT 



TITLE 

'ROUTINE TO TURN 

OFF ERROR RETRY BITS' 


ENTRY 

NOERR 



USING 

*,15 


NOERR 

01 

SPECTAPE+49,X'0C' 



BR 

14 

SHOULD BE CALLED BEFORE OPEN 


DROP 

15 



TITLE 

' INPUT BLKSIZE ROUTINE' 

BUSIZE 

DS 

OH 



L 

POINT, DECB+16 

GET POINTER TO STATUS INFO 


L 

TEMP, 12(0, POINT) 

GET RESIDUAL COUNT 


N 

TEMP, MASK 

ONLY USE LOW ORDER HALFWORD 


L 

COUNT, SPECTAPE+60 

GET BLKSIZE FROM DCB 


N 

COUNT, MASK 

ONLY USE LOW ORDER HALFWORD 


SR 

COUNT, TEMP 

SUBTRACT REMAINDER 


BR 

LINKR 

RETURN 


DS 

OF 


MASK 

DC 

X'OOOOFFFF' 





TITLE 

'READ ERROR ROUTINE' 


SYNAD 

DS 

OH 



SYNADAF ACSMETH»BSAM 



STM 

14^1, ERRSAV 

SAVE OS REGISTERS 


MVC 

STATUS(27)^=CL27'RSL110I I/O ERROR INFO — ' 


MVC 

STATUS+27(78),50(PARM) 



WTOP 

STATUS^ LIMIT=20,MF»E 



L 

COUNT^=F’-l' 

SET ERROR FLAG 


SYNADRLS 



LM 

14,1, ERRSAV 

RESTORE THE REGISTERS 

it 

BR 

14 

RETURN TO CHECK MODULE 

ERRSAV 

DC 

4A(0) 


STATUS 

WTOP 

27+78, MF=L 


SPECTAPE 

DCB 

DDNAME-SPECTAPE, DSORG=PS 

i,RECFM=U,BLKSIZE=400,MACRF=R 



EODAD»EODAD,SYNAD=SYNAD 



LTORG 




TITLE 

•COMMON DEFINITION' 


TDATA 

COM 



INPA 

DS 

SOD 

400 BYTE INPUT AREA 

w 

ORG 

INPA 

BACK TO START OF INPUT AREA 

SG I DENT 

EQU 

* 

IDENTIFICATION RECORD FORMAT 

SGNOISE 

DS 

(SGNSIZ)X 

NOISE BYTES 

SGDAY 

DS 

2X 

THREE DIGIT (BCD) DAY 

SGTIME 

DS 

4X 

SIX DIGIT TIME HH.MM.SS 

SGSAMPLE 

DS 

2X 

SAMPLE IDENTIFICATION 

SGSITE 

DS 

2X 

SITE IDENTIFICATION 

SGIDSIZ 

A 

EQU 

♦-SGIDENT 

DEFINE SIZE OF IDENT RECORD 


ORG 

INPA 

BACK TO START OF INPUT AREA 

SGOATA 

EQU 

* 

DATA RECORD FORMAT 

SGCHANLA 

DS 

2X 

FIRST SPECTROMETER HALFWORD 

SGCHANLB 

DS 

2X 

FIRST RADIOMETER HALFWORD 


DS 

(4*(SGDSIZ-1) )X 

REMAINDER OF SPECT/RAD DATA 

SGMU LT 

DS 

(2*6)X 

MULTIPLEX DATA 

SGDTSIZ 

EQU 

+-SGDATA 

DEFINE SIZE OF DATA RECORD 


ORG 

/ 

RESET LOCATION COUNTER 





IDENT 

DS 

6H 

ALLOCATE RESULT AREA 


ORG 

IDENT 

TO DEFINE IDFNT SUBFIELDS 

DAY 

DS 

2X 

CONVERTED FROM ABOVE 

TIMEH 

DS 

2X 


TIMEM 

DS 

2X 


TIMES 

DS 

2X 


SAMPLE 

DS 

2X 


SITE 

DS 

2X 


SPECT 

DS 

48H 

CONVERTED SPECTRUM AREA 

RADIO 

DS 

48H 

CONVERTED RADIOMETER AREA 

MULT 

DS 

6H 

CONVERTED MULTIPLEX AREA 

COMLENG 

EQU 

♦-INPA 

LENGTH SHOULD AGREE WITH MAIN 


TITLE 

•REGISTER 

DEFINITIONS' 

PARM 

EQU 

1 


TEMP 

EQU 

2 


TEM2 

EQU 

TEMP+1 


STEP 

EQU 

4 


LIMIT 

EQU 

5 


LRECL 

EQU 

6 


BCD 

EQU 

7 


COUNT 

EQU 

8 


POINT 

EQU 

9 


INDEX 

EQU 

10 


CBASE 

EQU 

11 


BASE 

EQU 

12 


SAVER 

EQU 

13 


LINKR 

EQU 

END 

14 



ry 



5*3 Subroutine Daload 


PRINT NOGEN 
DALOAD LINKS 

* 


* 

* 

♦ 

* 

* 

* 

* 

* 

* 

★ 

* 

* 

* 


SUBROUTINE DALOAD (DATA, KEY) 

DATA — LOCATION OF DATA TO BE WRITTEN 
KEY — ERROR CHECKING FEATURE, IF ZERO 
NO ERROR CHECKING WILL BE DONE, 

ELSE IT MUST AGREE WITH THE KEY 
OF THE BLOCK CURRENTLY BEING WRITTEN. 
DIRECT — DDNAME OF DIRECT ACCESS DATASET. 
BLKSI7E MUST APPEAR IN JCL. 

DSORG=DA MUST APPEAR IN JCL. 


* 

'k 

k 

k 

k 

k 

k 

k 

k 

k 

k 

k 


kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 



L 

DATA, 0(0^ PARM) 

GET POINTERS TO 


L 

KEY, 4(0, PARM) 



CLC 

BLKCNT, =F 'O' 

FIRST TIME THRU? 


BNE 

OPENED 



OPEN 

(DIRECT, (OUTPUT)) 



TO PEN 

DIRECT, OPENED 



WTO 

'RSLIOOI DIRECT DD 

CARD MISSING' 

ABEND 

ABEND 

20, DUMP 


OPENED 

L 

TEMP, BLKCNT 



LA 

TEMP, 1(0, TEMP) 

INCREMENT BLOCK 


ST 

TEMP, BLKCNT 



S 

TEMP, 0(0, KEY) 

ERROR CHECK 


C 

TEMP, BLKCNT 

WAS KEY ZERO? 


BE 

WRITE 



C 

TEMP,=F'0' 

WAS KEY EQUAL TO 


BE 

WRITE 



WTO 

'RSL120I DIRECT ACCESS KEY INVALID' 


B 

ABEND 


WRITE 

WRITE 

DECB,SF,DI RECT, (2) 



CHECK 

DECB 



L 

SAVER, 4(0, SAVER) 



RETURN 

(14,12) 



TITLE 

'DATA CONTROL BLOCK' 



PRINT 

GEN 


DIRECT 

DCB 

DDNAME=DI RE:T,DS0RG* 

PS,OPTCD=C,RECFM=F 

BLKCNT 

DC 

F'O' 



TITLE 

'REGISTER DEFINITIONS.' 

FARM 

EQU 

1 


DATA 

EQU 

2 


KEY 

EQU 

3 


TEMP 

EQU 

4 


TEM2 

EQU 

5 


BASE 

EQU 

12 


SAVER 

EQU 

13 


LINKR 

EQU 

14 



END 
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